TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started 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....
(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!
-
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.
-
(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
(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. :)
-
Ok, this is what I got now.
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
-
Ah, found my mistake
(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....
-
Your ssget function has to be passed a list:
yours: (setq ss (ssget "X" '(0 . "LWPOLYLINE") (70 . 0)))
mine: (setq ss (ssget "X" '((0 . "LWPOLYLINE") (70 . 0))))
-
(70 . 1)
-
Ok here is the problem. You need an extra return at the end of your command statement:
(command ".hatch" "ANSI31" "200" "" (ssname ss n) "")
-
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.
-
Thanks for the help, much appreciated. I knew that I was close, I just needed a kick in the head....
Thnx again
-
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:
(setq ss (ssget "x" '((0 . "POLYLINE,LWPOLYLINE")(-4 . "&")(70 . 1))))
The "&" forces a bitwise comparison looking for the 1 bit.
-
Provided for fun, as is, complete with warts & freckles ...
(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)
)
-
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.
-
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???
-
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.
-
not pretty but this works....
(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)
)
-
Well I tried to use MP's subroutine to draw the pline first but got an error
using ACAD2000. Must be the version of ACAD?
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
(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)
)
-
Ron, you snuck in there while I wasn't watchen... :)
-
Yeah but my look at my hacked together code compared to yours. :)
-
Works fine under 2004. Hmmm.
-
Yea, I just cranked up 2004 & my routine using your sub worked fine.
Go figure :roll:
By the way, nice code MP :)
-
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).
-
Hey -- thanks Alan. :)
-
Any time :)
-
Michael,
This is what fails in 2002:
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:RetVal = object.AddHatch(PatternType, PatternName, Associativity)
-
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.
(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)
)
-
That did the trick, works in A2k. :)
-
Thanks Alan -- If I didn't have a headache I'd optimize it a bit but alas ... :(
Nonetheless thank you for testing it.
:)
-
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.
-
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?
:)
-
Well I tried to use MP's subroutine to draw the pline first but got an error
using ACAD2000. Must be the version of ACAD?
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
(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) ..................
that was perfect! thanks cab you are the man!