TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: TJAM51 on February 17, 2006, 01:22:12 PM
-
I am seeking a lisp routine that would allow me to select by crossing or window or picking hatch that would dis-associate that hatch.....can anyone help me....
Thanks
-
;;;by: John D. Chapman
(defun c:NOA (/ sset CNT NCNT ents assoc? nonassoc)
(setq sset (ssget "x" '((0 . "hatch")))
CNT 0
NCNT 0)
(if sset
(progn
(repeat (sslength sset)
(setq ents (entget (ssname sset CNT))
assoc? (cdr (assoc 71 ents)))
(if (= assoc? 1)
(progn (setq nonassoc 0)
(setq ents (subst (cons 71 nonassoc) (assoc 71 ents) ents))
(entmod ents)
(setq CNT (1+ CNT)))
(progn (setq NCNT (1+ NCNT))
(prompt (strcat "\n" (itoa NCNT) " Hatch<s> already Non-Associative.")))))
(prompt (strcat "\n* " (itoa CNT) " Hatch<s> Changed *")))
(prompt "\n* No Hatches Found *"))
(princ))
-
Thank you for the routine but it did not work. The drawing I had already had non-associative hatch in it. I created a new hatch pattern area and left it associative. When I ran the routine it stated 0 hatch changed. Could it be that since there was a mixture of hatch it caused the program to fail....
Thanks
-
Try this one:
(defun C:NOA (/ sset CNT NCNT ents assoc? nonassoc)
(setq sset (ssget "x" '((0 . "hatch")))
CNT 0
NCNT 0)
(if sset
(progn (repeat (sslength sset)
(setq ents (entget (ssname sset CNT))
assoc? (cdr (assoc 71 ents)))
(if (= assoc? 0)
(progn (setq nonassoc 1)
(setq ents (subst (cons 71 nonassoc) (assoc 71 ents) ents))
(entmod ents)
(setq CNT (1+ CNT)))
(progn (setq NCNT (1+ NCNT))
(prompt (strcat "\n" (itoa NCNT) " Hatch<s> already Associative.")))))
(prompt (strcat "\n* " (itoa CNT) " Hatch<s> Changed *")))
(prompt "\n* No Hatches Found *"))
(princ))
Gary
-
I appreciate your assistance...here is the readout I just received....
Command: ap
APPLOAD
Command:
C:NOA
Command: noa
1 Hatch<s> already Associative.
2 Hatch<s> already Associative.
* 0 Hatch<s> Changed *
I checked each hatch and there was no change....I should say I am using 2002 LT with LT-extender that allows me to use most of not all my lisp routines. Would this have any effect on your routine?
Thanks
-
Here is one I just wrote, but after you post I don't know if it will work. You can give it a try. It is simple, no prompts telling you how many associative hatchs it removes.
(defun c:RemoveHatchAssoc (/ ss Ent)
(vl-load-com)
(if (setq ss (ssget '((0 . "HATCH"))))
(while (setq Ent (ssname ss 0))
(vla-put-AssociativeHatch
(vlax-ename->vla-object Ent)
:vlax-false
)
(ssdel Ent ss)
)
)
(princ)
)
-
I really appreciate your assistance but no luck...must be something wrong with Autocad. Thanks
-
I got my codes and Tim's to work fine. I'm using 2006.
(setvar "pickstyle" 1) ;0 No group selection or associative hatch selection
;1 Group selection
;2 Associative hatch selection
;3 Group selection and associative hatch selection
What is your pickstyle set to?
;;Nonassociative Hatch
(defun c:NOA (/ sset CNT NCNT ents assoc? nonassoc)
(setq sset (ssget "x" '((0 . "hatch")))
CNT 0
NCNT 0)
(if sset
(progn
(repeat (sslength sset)
(setq ents (entget (ssname sset CNT))
assoc? (cdr (assoc 71 ents)))
(if (= assoc? 1)
(progn (setq nonassoc 0)
(setq ents (subst (cons 71 nonassoc) (assoc 71 ents) ents))
(entmod ents)
(setq CNT (1+ CNT)))
(progn (setq NCNT (1+ NCNT))
(prompt (strcat "\n" (itoa NCNT) " Hatch<s> already Non-Associative.")))))
(prompt (strcat "\n* " (itoa CNT) " Hatch<s> Changed *")))
(prompt "\n* No Hatches Found *"))
(princ))
;;Associative Hatch Removed
(defun c:YSA (/ sset CNT NCNT ents assoc? nonassoc)
(setq sset (ssget "x" '((0 . "hatch")))
CNT 0
NCNT 0)
(if sset
(progn (repeat (sslength sset)
(setq ents (entget (ssname sset CNT))
assoc? (cdr (assoc 71 ents)))
(if (= assoc? 0)
(progn (setq nonassoc 1)
(setq ents (subst (cons 71 nonassoc) (assoc 71 ents) ents))
(entmod ents)
(setq CNT (1+ CNT)))
(progn (setq NCNT (1+ NCNT))
(prompt (strcat "\n" (itoa NCNT) " Hatch<s> already Associative.")))))
(prompt (strcat "\n* " (itoa CNT) " Hatch<s> Changed *")))
(prompt "\n* No Hatches Found *"))
(princ))
I like Tim's because you can select it.
Gary
-
Just change this line in your's then Gary
(setq sset (ssget "x" '((0 . "hatch")))
CNT 0
NCNT 0)
to
(setq sset (ssget '((0 . "hatch")))
CNT 0
NCNT 0)
To be able to select the hatch objects.
-
Tested on LT2004 + LTE, the function NOA works like a charm!
Do you have the latest LT-Extender? Jan. 5
-
Hey TJAM51,
This is from Torsten's site:
Version v1.9 - Build November/25/2005
--------------------------------------------------------------------------------
fixed Bugs and Errors:
LISP LT 2004-2006 : fixes a problem with (command PAUSE) function
LISP LT 2004-2006 : fixes a rare problem with DCL dialog management
LISP LT 2004-2006 : fixes a rare problem data transfer between LISP and ARX
LISP LT 2004-2006 : fixes some problems with (fix) and (rem) functions
LISP LT 2004-2006 : fixes a rare problems with (done_dialog) DCL management functions
LISP LT 2004-2006 : fixes some problems with (write-xxx) and (read-xxx) and (print) functions, if file descriptor was nil
fixes a rare problem related command recognition (hatch) Maybe 'tis the fixer!!?
... Snip
-
Another option:
(defun c:RHA (/ e1 temp)
(setq e1 0 temp (ssget '((0 . "HATCH"))))
(if temp (repeat (sslength temp)
(command ".-hatchedit" (ssname temp e1) "DI")
(redraw (ssname temp e1) 4)
(setq e1 (1+ e1))
))
(princ)
)
(not tested)
-
Another option:
(defun c:qass (/ ss sl ct e1)
(if (setq ss (ssget '((0 . "HATCH") (71 . 1))))
(setq ct 0))
(if ss
(repeat (sslength ss)
(setq e1 (entget (ssname ss ct)))
(entmod (subst (cons 71 0) (assoc 71 e1) e1))
(setq ct (+ ct 1))))
(princ)
)