Visual LISP, AutoLISP and General Customization
cancel
Showing results for 
Show  only  | Search instead for 
Did you mean: 

HATCH COLOUR LISP ROUTINE

36 REPLIES 36
Reply
Message 1 of 37
eforb
4193 Views, 36 Replies

HATCH COLOUR LISP ROUTINE

HI,

I am in need of a lisp routine which will automatically pick up all hatch and solid hatch patterns within a drawing and change the colour to colour 254.

Any help would be much appreciated.

Thank you
36 REPLIES 36
Message 2 of 37
chatsupakasem
in reply to: eforb

;;; Change all HATCH objects color to 254
;;; DXF 62 Color number (fixed)

(defun c:hc (/ oldcmd)
(setq oldcmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(command "_.chprop"
(ssget "x" (list (cons 0 "HATCH")))
""
"Color"
254
""
)
(princ "\nChange all hatch objects color to 254.")
(setvar "cmdecho" oldcmd)
(princ)
)
Message 3 of 37
eforb
in reply to: eforb

Thank you so much. It works great. Thank you
Message 4 of 37
CADD-Co
in reply to: eforb

I'm impressed with that routine and have a similar question.
Could it be modified to select only hatch 'Angle' and change only those to 'ANSI31' and colour 254?
Any assistance appreciated. Cheers
Message 5 of 37
chatsupakasem
in reply to: eforb

;;; Update OLDPATTERN to NEWPATTERN and Set color to NEWCOLOR.
;;; REPLACE VALUE OF OLDPATTERN, NEWPATTERN AND NEWCOLOR VARIABLES WHICH YOU WANT.
(defun c:H2 (/ newpattern oldpattern newcolor s ej a n)
(setvar "cmdecho" 0)
(setq oldpattern
"ANGLE" ; OLD PATTERN NAME
newpattern
"ANSI31" ; NEW PATTERN NAME
newcolor 254 ; NEW COLOR
)
(if (setq s (ssget "x" (list (cons 0 "HATCH") (cons 2 oldpattern))))
(progn
(setq n (sslength s))
(while (setq ej (ssname s 0))
(entmod
(subst (cons 2 newpattern) (assoc 2 (setq a (entget ej))) a)
)
(command "_.chprop" ej "" "Color" newcolor "")
(ssdel ej s)
)
(princ "\nChange ")
(princ n)
(princ (strcat " " oldpattern " to " newpattern " Hatch.")
)
)
(princ (strcat "No " oldpattern " Hatch found!!!"))
)
(setvar "cmdecho" 1)
(princ)
)
Message 6 of 37

Hi, in the first routine that you mentioned is it possible to change the hatch colour within the Block references or any DWG references? 
Any assistance will be of great help.
Thanks

Message 7 of 37


@raghavendrabhat6624 wrote:

Hi, in the first routine that you mentioned is it possible to change the hatch colour within the Block references or any DWG references? 
Any assistance will be of great help.
Thanks


Hatch of a specific pattern? to what color? Block modifcation affects all intances on a single drawing.

 

DWG references?

 

Are you refering to XREF?

 

 

Message 8 of 37

All Hatch patterns
Yes needed to reflect in all block references!

 

yes Xref's

Message 9 of 37

(defun c:HC ( aDoc color)
(vl-load-com)
(setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))  
  	(if (setq color (acad_colordlg 7 t))
	      (progn
		(vlax-for blk (vla-get-blocks aDoc)
		      (if (and
				(eq :vlax-false (vla-get-islayout blk))
				(eq :vlax-false (vla-get-isxref blk))
				)
		                 (vlax-for itm blk
		                       (if (eq  (vla-get-ObjectName itm)
		                                 "AcDbHatch" )
		                             (vla-put-color itm color)
		                       )
		                 )
	            )
		  )
      (vla-regen adoc acActiveViewport)
		)
	  )
      (princ)
      )

 

Message 10 of 37

I get this error,

error: too few arguments

Do i need to load some variables, please let me know

Message 11 of 37

oops.. my bad

 

(defun c:HC ( / aDoc color)

....

 

Message 12 of 37

I figured out "/" was missing in the defun line.

The lisp changes the colour of hatches in the blocks, but not the reference files, I mean the Xref , Any idea!

Message 13 of 37


@raghavendrabhat6624 wrote:

I figured out "/" was missing in the defun line.

The lisp changes the colour of hatches in the blocks, but not the reference files, I mean the Xref , Any idea!


Listen, we can include xref objects by taking this line out

(eq :vlax-false (vla-get-isxref blk))

 

But i would advice against it.. XREF are so named and to be trated as such. a Reference drawing.  

 Any modifications should be done on the drawing 

 

 

Just my 2 cents

 

(if 
				(eq :vlax-false (vla-get-islayout blk))
		                 (vlax-for itm blk
		                       (if (eq  (vla-get-ObjectName itm)
		                                 "AcDbHatch" )
		                             (vla-put-color itm color)
		                       )
		                 )
	            )

 

 

 

Message 14 of 37
cadheinz
in reply to: pbejse

Can we change that I can select a block in which I want to change the hatching
Thank you

 

 

Kann man das ändern das ich einen Block wählen kann bei dem ich die Schraffur ändern will

Danke

DH
Message 15 of 37
pbejse
in reply to: cadheinz


@heinz.dober wrote:

Can we change that I can select a block in which I want to change the hatching
Thank you

 


Have you decided what to do with XREF objects?

Message 16 of 37
cadheinz
in reply to: pbejse

X-ref I do not want to choose just one block.

X-ref brauche ich nicht, will nur einen Block wählen können

DH
Message 17 of 37

Thanks its Working!

Message 18 of 37
pbejse
in reply to: cadheinz


@heinz.dober wrote:

X-ref I do not want to choose just one block.

X-ref brauche ich nicht, will nur einen Block wählen können


Quick mod

 

NO XREF on selection mode/ Option to process all BLOCKS/XREF

 

 

 

(defun c:HC (/ _Chatch blk obj aDoc color)
  (vl-load-com)
  (defun _Chatch (b c)
    (vlax-for itm b
      (if (eq (vla-get-ObjectName itm)
	      "AcDbHatch"
	  )
	(vla-put-color itm c)
      )
    )
  )

  (setq aDoc (vla-get-ActiveDocument (vlax-get-acad-object)))
  (initget "A")
  (if (setq obj (entsel "\nSelect object to process/A for all: "))

    (progn
      (cond
	((listp obj)
	 (if (and
	       (eq "AcDbBlockReference"
		   (vla-get-ObjectName
		     (Setq blk (vlax-ename->vla-object (car obj)))
		   )
	       )
	       (not (vlax-property-available-p blk 'Path))
	       (setq blk
		      (vla-item	(vla-get-blocks aDoc)
				(vla-get-EffectiveName
				  blk
				)
		      )
	       )
	       (setq color (acad_colordlg 7 t))
	     )
	   (_Chatch blk color)
	   (princ "\nObject Not a Block:")
	 )
	)

	((eq obj "A")
	 (setq color (acad_colordlg 7 t))
	 (vlax-for blk (vla-get-blocks aDoc)
	   (if (and
		 (eq :vlax-false (vla-get-islayout blk))
		 (eq :vlax-false (vla-get-isxref blk))
	       )
	     (_Chatch blk color)
	   )
	 )
	)
      )
     (if color  (vla-regen adoc acActiveViewport))
    )
  )
  (princ)
)

 

Command: hc
Select object to process/A for all:

  

HTH

  

Message 19 of 37
cadheinz
in reply to: pbejse

Thank you 1000 times superSmiley Happy

 

1000 mal Danke   super 

DH
Message 20 of 37
pbejse
in reply to: cadheinz


@heinz.dober wrote:

Thank you 1000 times superSmiley Happy

 

1000 mal Danke   super 



@raghavendrabhat6624 wrote:

Thanks its Working!

 


 

I didnt realize there were two of you Smiley Very Happy

To both:
You are Welcome. Glad i could help
Cheers

Can't find what you're looking for? Ask the community or share your knowledge.

Post to forums  

Autodesk Design & Make Report

”Boost