LISP to create boundaries for each hatch layer

[Anonymous]

Hi Everyone,

I'm trying to create a LISP routine to process every hatch within a drawing file. The steps required are:

>for each hatch layer in the drawing

>set it as the current layer

>then generate a polyline boundary

>save drawing

I want the routine iterate through each hatch layer and create a polyline on that hatch layer.

The hatches are nonassociative.

I'm new to LISP so below is a snippet with which I would appreciate some help:

(defun c:rehash ()
(vl-load-com)
(while (setq OBJ (ssname SSET (setq CNT (1+ CNT))))
    (setvar 'clayer (cdr (assoc 8 (entget OBJ))))
    (command "-hatchedit" OBJ "b" "r" "y")
    (command "_.HATCHGENERATEBOUNDARY" hnd "")
)
)
 (princ)
) 

[pbejse]

---

@Anonymous wrote:

I'm trying to create a LISP routine to process every hatch within a drawing file.

Try this first, and see if that works for you  HATCHB.LSP by JTB 

[Anonymous]

Try this

(defun c:rehash ( / obj sset oldlay)
(setq oldlay (getvar 'clayer))
  (setq sset (ssget '((0 . "HATCH"))))
  (repeat (setq x (sslength sset))
    (setq OBJ (ssname SSET (setq x (- x 1))))
    (setvar 'clayer (cdr (assoc 8 (entget OBJ))))
    (command "-hatchedit" OBJ "b" "P" "N")
  )
  (setvar 'clayer oldlay)
  (command "regen")
  (princ)
)
(c:rehash)

[hosneyalaa]

try this

(defun c:test (/ ss i en)
(if (setq ss (ssget "_X" '((0 . "HATCH") )))
  (progn
(repeat (setq i (sslength ss))
  
(setq en (ssname ss (setq i (1- i))))
  (setq objvl (vlax-ename->vla-object en)) 
 
  (vlax-put-property objvl 'layer (getvar "clayer"))
  
  (command"_hatchedit"  en  "_boundary"  "_polyline"  "_yes" )
  
); repeat

(setvar "filedia" 0)

(vl-cmdf "_Saveas" "2013" "" "Y")

(setvar "filedia" 1)

)
); if
(princ)
)

[Anonymous]

8:55 8:56 8:57 all at same time.

[Anonymous]

Although this lisp did create polyline boundaries, it also mixed up my hatch layers....so it didn't work

[Anonymous]

crashes...

[Anonymous]

This routine requires that I select hatches....there are hundreds! Also, it creates boundaries on layer 0 and not on the hatch layer as required.

[ВeekeeCZ]

This is what I'm using for this.

Change ssget to (ssget "_X" (list '(0 . "HATCH") (cons 410 (getvar 'ctab)))) if you want to process all of them without user prompt to select them. And learn about ssget HERE 

---

(defun c:BoundaryMultiple (/ *error* adoc clay ss i enl i ssl clay) ; pgp B 
  
  (defun *error* (errmsg)
    (if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break,end"))
      (princ (strcat "\nError: " errmsg)))
    (and (= (logand 8 (getvar 'undoctl)) 8) adoc (vla-endundomark adoc))
    (if clay (setvar 'clayer clay))
    (princ))
  
  (if (setq ss (ssget "_:L" '((0 . "HATCH"))))
    (progn
      (setq clay (getvar 'CLAYER))
      (setvar 'PEDITACCEPT 1)
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      
      (repeat (setq i (sslength ss))
	(setq ent (ssname ss (setq i (1- i)))
	      enl (entlast)
	      ssl (ssadd))
	(setvar 'CLAYER (cdr (assoc 8 (entget ent))))
	(command "_.-HATCHEDIT" ent "_b" "_p" "_y")
	(while (setq enl (entnext enl))
	  (ssadd enl ssl))
	(if (> (sslength ssl) 1) 
	  (command "_.PEDIT" "_m" ssl "" "_j" "_j" "_b" "0.05" "")))
      (vla-endundomark adoc)
      ;(command "_erase" ss "")
      ;(vla-endundomark adoc)
      ;(princ "\n>> To restore hatches hit UNDO once.")
  ))
  (princ)
  )

[Anonymous]

As we had no test dwg just made something and it worked fine, you should post a test dwg so we can see why it crashes.