Jump to content

HELP: Lisp to hatch multiple closed polylines but result in individual hatch objects


vernonlee

Recommended Posts

Looking for a hatch lisp to window select multiple closed polylines & hatch them at once but result in individual hatch objects, base on current hatch settingd.

 

Came across this code but was it unable to base on current hatch settings

 

(defun c:mhatch (/ ang do-it doc hatch oname pname scl space ss)
(if (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
(progn
(setq scl (getvar "hpscale")
ang (getvar "hpang")
pname (getvar "hpname")
hpassoc (if (= (getvar "hpassoc") 1)
:vlax-true
:vlax-false)
doc (vla-get-activedocument
(vlax-get-acad-object))
space (if (= (getvar "cvport") 1)
(vla-get-paperspace doc)
(vla-get-modelspace doc)
)
)
(vlax-for ent (vla-get-activeselectionset doc)
(setq do-it nil
oname (strcase (vla-get-objectname ent)))
(cond ((vl-string-search "CIRCLE" oname)
(setq do-it t)
)
((and (vl-string-search "LINE" oname)
(eq (vla-get-closed ent) :vlax-true)
)
(setq do-it t)
)
((equal (vlax-curve-getstartpoint ent)
(vlax-curve-getendpoint ent)
1e-6)
(setq do-it t)
)
)
(if do-it
(progn
(setq hatch (vlax-invoke space 'addhatch acHatchObject pname hpassoc))
(vlax-invoke hatch 'appendouterloop (list ent))
(vlax-put hatch 'patternangle ang)
(vlax-put hatch 'patternscale scl)
(vla-evaluate hatch)
)
)
)
)
)
(princ)
)

 

Thanks

Link to comment
Share on other sites

Hi,

 

I have just wrote this program and added to my Lisp-box :)

 

(defun c:Test  (/ h _doc ss)
;;;	Tharwat 20.01.2014	;;
 (princ "\n Select closed objects to hatch as per current hatch settings ")
 (if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
           ss   (ssget '((-4 . "<OR")
                         (0 . "CIRCLE,ELLIPSE")
                         (-4 . "<AND")
                         (0 . "LWPOLYLINE")
                         (-4 . "&=")
                         (70 . 1)
                         (-4 . "AND>")
                         (-4 . "OR>"))))

   (vlax-for o  (vla-get-activeselectionset _doc)
     (setq h (vlax-invoke
               (vla-get-block (vla-get-activelayout _doc))
               'addhatch
               acHatchObject
               (getvar "hpname")
               (if (= (getvar "hpassoc") 1)
                 :vlax-true
                 :vlax-false)))
     (vlax-invoke h 'appendouterloop (list o))
     (vlax-put h 'patternangle (getvar "hpang"))
     (vlax-put h 'patternscale (getvar "hpscale"))
     (vla-evaluate h)
     )
   )
 (princ)
 )(vl-load-com)

Link to comment
Share on other sites

Hi Tharwat.

 

Tested it & somehow it will not follow current setting which is non associative.

 

When using the LISP to hatch, it still hatch as associative.

 

Any advise on this?

 

Thanks

Edited by vernonlee
Link to comment
Share on other sites

It seems that the parameter for the association is not making any sense with the use of the vlax-invoke function :o

 

Try this instead and let me know :)

 

(defun c:Test  (/ soc h _doc ss)
;;;	Tharwat 20.01.2014	;;
 (princ
   "\n Select closed objects to hatch as per current hatch settings ")
 (if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
           soc (if (= (getvar "hpassoc") 1)
                 :vlax-true
                 :vlax-false)
           ss   (ssget '((-4 . "<OR")
                         (0 . "CIRCLE,ELLIPSE")
                         (-4 . "<AND")
                         (0 . "LWPOLYLINE")
                         (-4 . "&=")
                         (70 . 1)
                         (-4 . "AND>")
                         (-4 . "OR>"))))
   (vlax-for o  (vla-get-activeselectionset _doc)
     (setq h (vlax-invoke
               (vla-get-block (vla-get-activelayout _doc))
               'addhatch
               acHatchObject
               (getvar "hpname")
               soc))
     (vlax-invoke h 'appendouterloop (list o))
     (vla-put-AssociativeHatch h soc)
     (vlax-put h 'patternangle (getvar 'hpang))
     (vlax-put h 'patternscale (getvar 'hpscale))
     (vla-evaluate h)
     )
   )
 (princ)
 ) (vl-load-com)

Link to comment
Share on other sites

Hi Tharwat.

 

I now works.

 

But i realised some of the polylines are not closed but look close (did not know there was such a thing), which the normal hatch command can select.

 

Could you include those that can be selected by normal hatch command? :oops:

 

Thanks

Edited by vernonlee
Link to comment
Share on other sites

Why you are quoting every reply ? just a simple reply is more than enough if you don't reply to a specific point , remove the two programs from your replies please to keep the thread 's representation looking good at least .

 

Could you include those that can be selected by normal hatch command? :oops:

 

Replace my selection set function with yours .

 

eg.

 

(setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))

 

with the highlighted codes ONLY .

 

(setq _doc (vla-get-activedocument (vlax-get-acad-object))
           soc (if (= (getvar "hpassoc") 1)
                 :vlax-true
                 :vlax-false)
[color="red"]            ss   (ssget '((-4 . "<OR")
                         (0 . "CIRCLE,ELLIPSE")
                         (-4 . "<AND")
                         (0 . "LWPOLYLINE")
                         (-4 . "&=")
                         (70 . 1)
                         (-4 . "AND>")
                         (-4 . "OR>")))[/color]
)

Link to comment
Share on other sites

Roger. Will clean up my previous post.

 

Did the code replacement & i got this error when i load the lisp

 

; error: malformed list on input

 

my code after replacement is this

 

 

(defun c:Test  (/ soc h _doc ss)
;;;    Tharwat 20.01.2014    ;;
 (princ
   "\n Select closed objects to hatch as per current hatch settings ")
 (if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
           soc (if (= (getvar "hpassoc") 1)
                 :vlax-true
                 :vlax-false)
           (setq ss (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE"))))
)
   (vlax-for o  (vla-get-activeselectionset _doc)
     (setq h (vlax-invoke
               (vla-get-block (vla-get-activelayout _doc))
               'addhatch
               acHatchObject
               (getvar "hpname")
               soc))
     (vlax-invoke h 'appendouterloop (list o))
     (vla-put-AssociativeHatch h soc)
     (vlax-put h 'patternangle (getvar 'hpang))
     (vlax-put h 'patternscale (getvar 'hpscale))
     (vla-evaluate h)
     )
   )
 (princ)
 ) (vl-load-com)

Link to comment
Share on other sites

No , Read this modification and compare it with your last reply .

 

(defun c:Test  (/ soc h _doc ss)
;;;    Tharwat 20.01.2014    ;;
 (princ
   "\n Select closed objects to hatch as per current hatch settings ")
 (if (setq _doc (vla-get-activedocument (vlax-get-acad-object))
           soc  (if (= (getvar "hpassoc") 1)
                  :vlax-true
                  :vlax-false)
           ss   (ssget '((0 . "LWPOLYLINE,POLYLINE,CIRCLE,ELLIPSE")))
           )
   (vlax-for o  (vla-get-activeselectionset _doc)
     (setq h (vlax-invoke
               (vla-get-block (vla-get-activelayout _doc))
               'addhatch
               acHatchObject
               (getvar "hpname")
               soc))
     (vlax-invoke h 'appendouterloop (list o))
     (vla-put-AssociativeHatch h soc)
     (vlax-put h 'patternangle (getvar 'hpang))
     (vlax-put h 'patternscale (getvar 'hpscale))
     (vla-evaluate h)
     )
   )
 (princ)
 )(vl-load-com)

Link to comment
Share on other sites

Ok. I guess as much I did something wrong. Will compare them to see where I went wrong when I am back in office tomorrow & test the code as well. Will feedback then.

 

 

Thanks again bro.

Link to comment
Share on other sites

Hi Tharwat.

 

Tested it & had this error. Also not all selected objects are hatched. Out of 25 selected, only 6 are hatched.

 

Command: TEST

 

Select closed objects to hatch as per current hatch settings

Select objects: Specify opposite corner: 25 found

 

Select objects:

Hatch boundary associativity removed.

Hatch boundary associativity removed.

Hatch boundary associativity removed.

Hatch boundary associativity removed.

Hatch boundary associativity removed.

Hatch boundary associativity removed.; error: AutoCAD.Application: Invalid input

 

Command:

Hatch boundary associativity removed.

Link to comment
Share on other sites

Tested it further & yes that is correct. If there is an open object within the selected, that error will occur.

 

Will play around with the 2 lisp to see which fits me better.

 

Thanks again :thumbsup:

Link to comment
Share on other sites

Tested it further & yes that is correct. If there is an open object within the selected, that error will occur.

 

And that's why I have changed the way of selecting objects before to avoid selecting open Polylines ;)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...