# TheSwamp

## Code Red => AutoLISP (Vanilla / Visual) => Topic started by: V-Man on August 23, 2005, 09:40:14 AM

Title: Hatch by polyline Question
Post by: V-Man on August 23, 2005, 09:40:14 AM
Hiya guys,

I'm trying to write a lisp to count how many polylines there are in a drawing and based on that info create a hatch individually for each. How can I accomplish this?

I have this so far....

Code: [Select]
`(defun C:HP ()(command "_undo" "_g")  (setq ss (ssget "X" '((-4 . "<AND")(0 . "LWPOLYLINE")                                 (-4 . "AND>"))))  (if ss    (progn      (setq n (1- (sslength ss)))        (repeat n           (command ".hatch" "ANSI31" "200" "" (ssname ss n)))))   (command "._undo" "_end")  (princ))`

Any thoughts definately welcome!
Title: Hatch by polyline Question
Post by: whdjr on August 23, 2005, 10:08:24 AM
Well I think in order to hatch a polyline it needs to be closed, so a check for that should be included in your ssget list:  (70 . 1).

You really don't need the <ANDs in your list unless you are polling for the same dxf number.
Title: Re: Hatch by polyline Question
Post by: whdjr on August 23, 2005, 10:13:52 AM
Quote from: dvarino
Code: [Select]
`(defun C:HP ()(command "_undo" "_g")  (setq ss (ssget "X" '((-4 . "<AND")(0 . "LWPOLYLINE")                                 (-4 . "AND>"))))  (if ss    (progn      (setq n (1- (sslength ss)))        (repeat n           (command ".hatch" "ANSI31" "200" "" (ssname ss n)))))   (command "._undo" "_end")  (princ))`

Another way you could write the IF statement without using 'prog' is like this
Code: [Select]
`(if ss  (repeat (setq n (sslength ss))    (setq n (1- n))    (command ".hatch" "ANSI31" "200" "" (ssname ss n))  ))`

Just another way to do the same thing. :)
Title: Hatch by polyline Question
Post by: V-Man on August 23, 2005, 10:20:56 AM
Ok, this is what I got now.

Code: [Select]
`Command: (defun C:HP ()(_> (command "_undo" "_g")(_>   (setq ss (ssget "X" '(0 . "LWPOLYLINE")(70 . 0)))(_> (if ss((_>   (repeat (setq n (sslength ss))(((_>     (setq n (1- n))(((_>     (command ".hatch" "ANSI31" "200" "" (ssname ss n))(((_>   )((_> )(_>    (command "._undo" "_end")(_>   (princ)(_> )`

I get this when i run the routine.

; error: bad argument type: consp 0
Title: Hatch by polyline Question
Post by: V-Man on August 23, 2005, 10:24:36 AM
Ah, found my mistake

Code: [Select]
`(defun C:HP ()(command "_undo" "_g")  (setq ss (ssget "X" '((0 . "LWPOLYLINE")(70 . 0))))(if ss   (repeat (setq n (sslength ss))     (setq n (1- n))     (command ".hatch" "ANSI31" "200" "" (ssname ss n))   ) )   (command "._undo" "_end")  (princ))`

But this till will not hatch....
Title: Hatch by polyline Question
Post by: whdjr on August 23, 2005, 10:29:51 AM
Your ssget function has to be passed a list:
Code: [Select]
`yours:  (setq ss (ssget "X" '(0 . "LWPOLYLINE") (70 . 0)))mine:   (setq ss (ssget "X" '((0 . "LWPOLYLINE") (70 . 0))))`
Title: Hatch by polyline Question
Post by: whdjr on August 23, 2005, 10:30:30 AM
(70 . 1)
Title: Hatch by polyline Question
Post by: whdjr on August 23, 2005, 10:38:21 AM
Ok here is the problem.  You need an extra return at the end of your command statement:

Code: [Select]
`(command ".hatch" "ANSI31" "200" "" (ssname ss n) "")`
Title: Hatch by polyline Question
Post by: whdjr on August 23, 2005, 10:42:52 AM
Just remember that

(70 . 0)  selects non-closed polylines (however the ending segments still need to cross for the hatch to display)

and

(70 . 1) selects closed polylines.

If you want it to do both the just take out the (70 . ?) all together.
Title: Hatch by polyline Question
Post by: V-Man on August 23, 2005, 01:07:41 PM
Thanks for the help, much appreciated. I knew that I was close, I just needed a kick in the head....

Thnx again
Title: Hatch by polyline Question
Post by: Jeff_M on August 23, 2005, 04:40:54 PM
Just to throw in my \$0.02.....if a Pline's linetypegen is set to on, bit 128 is added to the group 70 code......you really should use it like this:
Code: [Select]
`(setq ss (ssget "x" '((0 . "POLYLINE,LWPOLYLINE")(-4 . "&")(70 . 1))))`The "&" forces a bitwise comparison looking for the 1 bit.
Title: Hatch by polyline Question
Post by: MP on August 23, 2005, 05:16:38 PM
Provided for fun, as is, complete with warts & freckles ...

Code: [Select]
`(defun c:HatchEm ( / _HatchIt ss i space )    (defun _HatchIt ( space object / hatch err )        (setq err            (vl-catch-all-apply               '(lambda ()                    (setq hatch                        (vlax-invoke                            space                           'AddHatch                            acHatchStyleNormal ;; pattern type                                            "ANSI31"           ;; pattern name                            :vlax-false        ;; associativity                             AcHatchObject      ;; hatch object type                        )                    )                        (vlax-invoke                        hatch                       'AppendOuterLoop                        (list object)                    )                       (vlax-invoke hatch 'Evaluate)                )                )            )        (if (vl-catch-all-error-p err)            (princ                (strcat                    "Entity handle:"                    (vla-get-handle object)                    " caused this error: "                    (vl-catch-all-error-message err)                )            )            )        )        (cond        (   (setq ss                 (ssget                    '(   (0 . "lwpolyline,polyline")                        (-4 . "&")                        (70 . 1)                    )                )            )            (setq space                (vlax-get-property                    (vlax-get-property                        (vlax-get-acad-object)                       'ActiveDocument                    )                    (if (eq 1 (getvar "cvport"))                       'PaperSpace                       'ModelSpace                    )                )            )                (repeat (setq i (sslength ss))                (_HatchIt                    space                    (vlax-ename->vla-object                        (ssname ss (setq i (1- i)))                    )                )            )        )    )        (princ))`
Title: Hatch by polyline Question
Post by: dubb on August 23, 2005, 05:27:45 PM
that was a great code...

**i might be hijacking but,

how do i make it so that i draw some lines first then the hatch automatically goes in. without having to create a polyline and then running the routine.
Title: Hatch by polyline Question
Post by: LE on August 23, 2005, 06:28:42 PM
Quote from: dubb
how do i make it so that i draw some lines first then the hatch automatically goes in. without having to create a polyline and then running the routine.

Are you thinking of vlisp reactors???
Title: Hatch by polyline Question
Post by: dubb on August 23, 2005, 06:46:48 PM
Quote from: LE
Quote from: dubb
how do i make it so that i draw some lines first then the hatch automatically goes in. without having to create a polyline and then running the routine.

Are you thinking of vlisp reactors???

well im a noob to lisp..but i have developed a few programs.

will this type of routine that im talking about, require the use of reactors? i hear reactors are difficult to work with.
Title: Hatch by polyline Question
Post by: ronjonp on August 23, 2005, 07:03:02 PM
not pretty but this works....

Code: [Select]
`(defun c:plh (/  u-plinegen u-clayer u-plinewid *error* drawpline)         ;_____________________________;Error function;_____________________________(defun *error* (msg)   (if      (not        (member          msg          '("console break" "Function cancelled" "quit / exit abort" "")        )      )       (princ (strcat "\nError: " msg))    ) ; if(setvar 'plinegen u-plinegen)(setvar 'clayer u-clayer)(setvar 'plinewid u-plinewid)    (princ)  ) ;end error function ;_____________________________;Function to draw polyline;_____________________________(defun drawpline (/)  (command "_.pline")  ;;   repeat a point input until Enter  (if (while (> (getvar "CMDACTIVE") 0) (command pause)      )    (*error* "")  ));_____________________________;Get User Variables;_____________________________(setq u-plinegen (getvar 'plinegen) u-clayer   (getvar 'clayer) u-plinewid (getvar 'plinewid))(if (tblsearch "layer" "mylayer")(command "-layer" "thaw" "mylayer" "on" "mylayer" ""))       (setvar 'plinegen 1)      (setvar 'plinewid (* (getvar "dimscale") 0.025))      (command "_.-Layer" "_Make" "mylayer" "_L" "hidden2" "" "_Color" "4" "" "")   (drawpline)(command ".hatch" "ANSI31" "1" "45" "last" "");_____________________________;Reset User Variables;_____________________________    (setvar 'plinegen u-plinegen)   (setvar 'clayer u-clayer)   (setvar 'plinewid u-plinewid)  )`
Title: Hatch by polyline Question
Post by: CAB on August 23, 2005, 07:15:30 PM
Well I tried to use MP's subroutine to draw the pline first but got an error

Entity handle:162A9 caused this error: Invalid number of parametersEntity
handle:16A33 caused this error: Invalid number of parameters

Anyway here is my febal attempt

;;  Draw a polyline then it auto hatches it
;;  No error checking on my code
Code: [Select]
`(defun c:phatch (/ elast space)  ;;  sub by MP  (defun _HatchIt (space object / hatch err)    (setq err           (vl-catch-all-apply             '(lambda ()                (setq hatch                       (vlax-invoke                         space 'AddHatch achatchstylenormal                         ;; pattern type                                         "ANSI31"                         ;; pattern name                          :vlax-false                         ;; associativity                          AcHatchObject                         ;; hatch object type                         )                )                (vlax-invoke                  hatch                  'AppendOuterLoop                  (list object)                )                (vlax-invoke hatch 'Evaluate)              )           )    )    (if (vl-catch-all-error-p err)      (princ        (strcat          "Entity handle:"          (vla-get-handle object)          " caused this error: "          (vl-catch-all-error-message err)        )      )    )  )  (setq elast (entlast))  (prompt "\nDraw area to hatch, use C to close area.")  ;;   repeat a point input until Enter  (command "PLINE")  (while (> (getvar "CMDACTIVE") 0)    (command pause)  )  (if (and (/= (entlast) elast)           (= (cdr (assoc 0 (entget (entlast)))) "LWPOLYLINE")      )    (progn      (setq space             (vlax-get-property               (vlax-get-property                 (vlax-get-acad-object)                 'ActiveDocument               )               (if (eq 1 (getvar "cvport"))                 'PaperSpace                 'ModelSpace               )             )      )      (_HatchIt space (vlax-ename->vla-object (entlast)))    )  )  (princ))`
Title: Hatch by polyline Question
Post by: CAB on August 23, 2005, 07:17:07 PM
Ron, you snuck in there while I wasn't watchen... :)
Title: Hatch by polyline Question
Post by: ronjonp on August 23, 2005, 07:22:13 PM
Yeah but my look at my hacked together code compared to yours. :)
Title: Hatch by polyline Question
Post by: MP on August 23, 2005, 07:24:51 PM
Works fine under 2004. Hmmm.
Title: Hatch by polyline Question
Post by: CAB on August 23, 2005, 07:39:10 PM
Yea, I just cranked up 2004 & my routine using your sub worked fine.

Go figure :roll:

By the way, nice code MP  :)
Title: Hatch by polyline Question
Post by: MP on August 23, 2005, 08:31:35 PM
This just in: Works in AutoCAD 2006. :roll:

I don't have 2002 here at home but maybe I can figure what make it face plant in older versions tomorrow at work (when I can steal a moment or two).
Title: Hatch by polyline Question
Post by: MP on August 23, 2005, 08:34:04 PM
Hey -- thanks Alan. :)
Title: Hatch by polyline Question
Post by: CAB on August 23, 2005, 08:40:50 PM
Any time :)
Title: Hatch by polyline Question
Post by: Jeff_M on August 23, 2005, 10:33:24 PM
Michael,
This is what fails in 2002:
Code: [Select]
`AcHatchObject      ;; hatch object type`
This is not a parameter that needs to be set in 2002.....looks like Adesk changed the AddHatch method. From the Help:
Quote
Title: Hatch by polyline Question
Post by: MP on August 23, 2005, 10:59:54 PM
Thanks Jeff, excellent detective work. It's easy to code around this (though coded blind).

I'll try to run this under 2000/2002 tomorrow, hopefully it won't toss too much egg on me face.

Code: [Select]
`(defun c:HatchEm ( / *error* _HatchIt _HatchItSub version ss i space )    (cond        (   (> 15 (setq version (atoi (getvar "acadver"))))            ;;  shreik! AutoCAD 14 and older            (princ "Upgrade your AutoCAD mang!\n")            (defun *error* (x) (princ))            (exit)        )        (   (< 15 version)            ;;  AutoCAD 2004+            (defun _HatchItSub ( space )                (vlax-invoke                    space                   'AddHatch                    acHatchStyleNormal ;; pattern type                                   "ANSI31"           ;; pattern name                    :vlax-false        ;; associativity                    AcHatchObject      ;; hatch object type                )            )        )        (   ;;  AutoCAD 2000 / 2002            (defun _HatchItSub ( space )                (vlax-invoke                    space                   'AddHatch                    acHatchStyleNormal ;; pattern type                                   "ANSI31"           ;; pattern name                    :vlax-false        ;; associativity                )            )        )        )    (defun _HatchIt ( space object / hatch err )        (setq err            (vl-catch-all-apply               '(lambda ()                    (setq hatch (_HatchItSub space))                    (vlax-invoke                        hatch                       'AppendOuterLoop                       (list object)                    )                       (vlax-invoke hatch 'Evaluate)                )               )           )        (if (vl-catch-all-error-p err)            (princ                (strcat                    "Entity handle:"                    (vla-get-handle object)                    " caused this error: "                    (vl-catch-all-error-message err)                )            )           )       )        (cond        (   (setq ss                (ssget                   '(   (0 . "lwpolyline,polyline")                        (-4 . "&")                        (70 . 1)                    )                )            )            (setq space                (vlax-get-property                    (vlax-get-property                        (vlax-get-acad-object)                       'ActiveDocument                    )                    (if (eq 1 (getvar "cvport"))                       'PaperSpace                       'ModelSpace                    )                )            )               (repeat (setq i (sslength ss))                (_HatchIt                    space                    (vlax-ename->vla-object                        (ssname ss (setq i (1- i)))                    )                )            )        )    )       (princ))`
Title: Hatch by polyline Question
Post by: CAB on August 23, 2005, 11:38:50 PM
That did the trick, works in A2k. :)
Title: Hatch by polyline Question
Post by: MP on August 23, 2005, 11:44:17 PM
Thanks Alan -- If I didn't have a headache I'd optimize it a bit but alas ... :(

Nonetheless thank you for testing it.

:)
Title: Hatch by polyline Question
Post by: Jeff_M on August 24, 2005, 12:25:15 AM
Well Michael, you never cease to amaze me. It's late and you have a headache, yet your code always manages to look 10x better than mine AND you manage to throw a bit of humor into your code as well.

I'm glad I could spot the trouble spot rather quickly for you. I was going to offer a solution, nearly the same as yours (I never even would of thought to include the check for < 15...) but it was nearly dinner time and my night to cook. I'm glad you posted before I made it back :P , you saved me from mangling your code.
Title: Hatch by polyline Question
Post by: MP on August 24, 2005, 07:58:09 AM
You're too generous and humble Jeff! And for the record I've never seen you post mangled code, oh contraire, you've posted a lot of gems. Between your coding skills and a penchant to jump in and help your're not only a great asset but a great friend to swamp folk.

When do we eat?

:)
Title: Hatch by polyline Question
Post by: dubb on August 24, 2005, 11:27:56 AM
Quote from: CAB
Well I tried to use MP's subroutine to draw the pline first but got an error
`(defun c:phatch (/ elast space)  ;;  sub by MP  (defun _HatchIt (space object / hatch err)    (setq err           (vl-catch-all-apply             '(lambda ()                (setq hatch                       (vlax-invoke                         space 'AddHatch achatchstylenormal                         ;; pattern type                                         "ANSI31"                         ;; pattern name                          :vlax-false                         ;; associativity                          AcHatchObject                         ;; hatch object type                         )                )                (vlax-invoke                  hatch                  'AppendOuterLoop                  (list object)                )                (vlax-invoke hatch 'Evaluate)  ..................`