Topic: Lisp routine for dis-associating all hatch in a drawing

[TJAM51]

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

[GDF]

Code: [Select]

;;;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))


[TJAM51]

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

[GDF]

Try this one:

Code: [Select]

(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

[TJAM51]

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

[T.Willey]

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.

Code: [Select]

(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)
)


[TJAM51]

I really appreciate your assistance but no luck...must be something wrong with Autocad. Thanks

[GDF]

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?

Code: [Select]

;;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

[T.Willey]

Just change this line in your's then Gary

Code: [Select]

  (setq sset (ssget "x" '((0 . "hatch")))
        CNT  0
        NCNT 0)
to

Code: [Select]

  (setq sset (ssget '((0 . "hatch")))
        CNT  0
        NCNT 0)
To be able to select the hatch objects.

[Serge J. Gianolla]

Tested on LT2004 + LTE, the function NOA works like a charm!

Do you have the latest LT-Extender? Jan. 5

[Serge J. Gianolla]

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

[Crank]

Another option:

Code: [Select]

(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)

[paulmcz]

Another option:

Code: [Select]

(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)
)