Need help with LISP code Hatch Creation
@Hannan1 wrote:
.... place it with "inspt" of hatch origin point, I'm trying to access Origin point unfortunately exactly DXF code is not there....
The origin point is held in Extended Data, not just the regular entity data. This will show you the Extended Data:
(cadr (assoc -3 (entget TheHatchEntityName '("ACAD"))))
which for a Hatch pattern, looks something like this:
("ACAD" (1010 18.5668 7.57394 0.0))
The numbers following the 1010 are the XYZ coordinates of the origin point.
I've been trying to find the way to substitute a different origin point into that, so far without success. But maybe someone out there knows how to inject different values into Extended Data. Or, I've been trying on an existing Hatch pattern by substitution, but maybe it's easier within (entmakex)ing it.
@Hannan1 wrote:
.... the problem is hatch does not create inside closed polyline.
Does it not create it at all, or does it create it but somewhere else? Are there any messages? If it doesn't create it at all, maybe you're missing some essential entry -- look in the DXF Reference to see which are optional-with-default.
One thing I notice is that you have (cons 10) entries for vertices in the Hatch list with a repeat of the first one at the end. Hatch patterns' entity data does not have that -- it would be just the four.
Another thing, which may not matter if your Polyline is being created successfully: The 10 entries in Polyline entity data do not contain Z coordinates as yours do [that's set by the elevation property]. I was surprised to find that those for Hatches do, which implies that a Hatch should be able to be non-planar, but I haven't experimented.
Or, as already suggested, just use a HATCH command -- also much easier than (entmakex). So is a RECTANG command for the rectangle [if it's orthogonal as in your case], because it needs only two opposite corners, not all four. If you were specifying a Layer for either of them that might not be current, maybe that would suggest (entmakex), but you're not, so in either case the current Layer will be used [likewise for certain other properties].
Saludos @Hannan1
Prueba a aplicar el hatch de una forma más sencilla con "comando"...
(defun c:rh (/pl)
(prompt "\nRectangle with Hatch and Associated Boundary\n")
(setq len (getreal "\nEnter the length of the rectangle: "))
(setq wid (getreal "\nEnter the width of the rectangle: "))
(setq center (getpoint "\nSpecify the center point of the rectangle: "))
(setq half-len (/ len 2))
(setq half-wid (/ wid 2))
(setq pt1 (list (- (car center) half-len) (- (cadr center) half-wid) 0.0))
(setq pt2 (list (+ (car center) half-len) (- (cadr center) half-wid) 0.0))
(setq pt3 (list (+ (car center) half-len) (+ (cadr center) half-wid) 0.0))
(setq pt4 (list (- (car center) half-len) (+ (cadr center) half-wid) 0.0))
(setq pl (entmakex
(list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 4)
'(70 . 1)
(cons 10 pt1)
(cons 10 pt2)
(cons 10 pt3)
(cons 10 pt4)
)
))
(if pl
(command "_hatch" "" pl "")
(princ "\nError: Failed to create polyline.")
)
(princ)
)
Carlos Calderon G
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
@calderg1000 wrote:
Try applying the hatc in a simpler way with "command"...
If going with the (command) approach for the Hatch, it may as well be used for the rectangle, too. And the Hatch command should have more in it. And various things can be consolidated [more than one variable can be defined in a single (setq) function, and more than one command specified in a single (command) function]. And variables should be localized. Lightly tested:
(defun C:RectHatch (/ len wid ctr half-len half-wid)
(prompt "\nRectangle with Hatch and Associated Boundary\n")
(setq
len (getdist "\nHorizontal dimension of rectangle: ")
wid (getdist "\nVertical dimension of rectangle: ")
ctr (getpoint "\nCenter point of rectangle: ")
half-len (/ len 2)
half-wid (/ wid 2)
); setq
(command
"_.rectang"
"_non" (mapcar '- ctr (list half-len half-wid))
"_non" (mapcar '+ ctr (list half-len half-wid))
"_.hatch" "ANSI31" 1 0 "_last" ""
); command
(prin1)
)Note the use of (getdist) for the length/width [which it prompts for in different and unambiguous terms], which allows you to pick on-screen, or to enter in whatever type of units you're using [such as feet-inches-fractions], not only in integer or decimal format.
Regards @Hannan1
Here is another similar form...
;;;___
(defun c:rh (/)
(prompt "\nRectangle with Hatch and Associated Boundary\n")
(initget 7)
(setq len (getreal "\nEnter the length of the rectangle: "))
(initget 7)
(setq
wid (getreal "\nEnter the width of the rectangle: ")
center (getpoint "\nSpecify the center point of the rectangle: ")
pv (list (* len 0.5) (* wid 0.5))
pt2 (mapcar '(lambda (u v) (+ u v)) center pv)
pt1 (mapcar '(lambda (u v) (- u v)) center pv)
)
(command "_rectangle" "_non" pt1 "_non" pt2)
(command "_hatch" "ANSI32" "1" "0" (entlast) "")
(princ)
)
Carlos Calderon G
>Did you find this post helpful? Feel free to Like this post.
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
hey,
maybe the problem is with your using vlax in every occasion, while it surely is needed in your case when you are getting/putting points, cause
(vla-get-origin...) gets an array
and (vlax-get ... 'origin) gets a list
in case with colors both return vla-object, no difference which one to use. vla is shorter.
check the following. works fine for hatches with background colors.
(defun c:RectHatch (/ len wid center pv pt1 pt2 source_hatch pattern hatch_object outer_loop rectangle)
(prompt "\nRectangle with Hatch and Associated Boundary\n")
(initget 7)
(setq len (getreal "\nEnter the length of the rectangle: "))
(initget 7)
(setq wid (getreal "\nEnter the width of the rectangle: "))
(setq center (getpoint "\nSpecify the center point of the rectangle: "))
(setq source_hatch (car (entsel "\nSelect an existing hatch to match properties: ")))
(if (and source_hatch (eq (cdr (assoc 0 (entget source_hatch))) "HATCH"))
(progn
(setq vla-source-hatch (vlax-ename->vla-object source_hatch))
(setq pattern (vla-get-patternname vla-source-hatch))
(setq pv (list (* len 0.5) (* wid 0.5))
pt2 (mapcar '(lambda (u v) (+ u v)) center pv)
pt1 (mapcar '(lambda (u v) (- u v)) center pv))
(command "_rectangle" "_non" pt1 "_non" pt2)
(setq rectangle (vlax-ename->vla-object (entlast)))
(setq hatch_object (vla-addhatch
(vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
achatchpatterntypepredefined
pattern
:vlax-true
achatchobject))
(setq outer_loop (vlax-make-safearray vlax-vbobject '(0 . 0)))
(vlax-safearray-put-element outer_loop 0 rectangle)
(vla-appendouterloop hatch_object outer_loop)
(vla-put-patternscale hatch_object (vla-get-patternscale vla-source-hatch))
(vla-put-patternangle hatch_object (vla-get-patternangle vla-source-hatch))
(vla-put-patterndouble hatch_object (vla-get-patterndouble vla-source-hatch))
(vla-put-layer hatch_object (vla-get-layer vla-source-hatch))
(vla-put-backgroundcolor hatch_object (vla-get-backgroundcolor vla-source-hatch))
(vlax-put hatch_object 'origin (list (car center) (cadr center)))
(vla-update hatch_object)
(princ (strcat "\nRectangle with Hatch created successfully on layer: " (vla-get-layer hatch_object)))
)
(princ "\nError: Please select a valid hatch to match properties.")
)
(princ)
)
and finally
"If the PatternType property is set to acHatchPatternTypePreDefined or acHatchPatternTypeCustomDefined, then the PatternDouble property is not used."
so there is no use for PatternDouble.
