Make Region(Union) using Polyline & separate hatch

[ctpgamage]

Dear Brothers,

I have to Qestions i have attach CAD for that two qestions

I want a lisp file to create Assoiciated region using separete poly line and separate hatch.i can do it command of create region and union command but if i do so its take some time i want to do it quickly using lisp file.please help me someone to do this

thanks

gamage

[Anonymous · Accepted solution]

Hi ctpgamage,

Here is one quick code, minimum testing:

(defun c:ssunion (/ ss ssunion ename)
  (setq ss (ssget '((-4 . "<OR")
		      (0 . "LWPOLYLINE")
		      (0 . "HATCH")
		      (-4 . "OR>")))
	)
  (setq ssunion (ssadd))
  (while (setq ename (ssname ss 0))
    (cond
      ((= "HATCH" (cdr (assoc 0 (entget ename))))
       (command "-hatchedit" ename "b" "r" "n")
       )
       ((= "LWPOLYLINE" (cdr (assoc 0 (entget ename))))
	(command "region" ename "")
	)
      );end cond
    (ssdel ename ss)
    (ssadd (entlast) ssunion )
    )
  (command "union" ssunion "")
  )

Hope that this is going to help you.

dicra

[ctpgamage]

thanks dear Dicra....you lisp was helpfull thank you very much

[Anonymous]

gamage,

You're welcome, glad I could help.

Here is one quick remark, I just added Lee Macs undo commands.

Whit these commands, if You need to use undo, it is not going to go  step by step trough lisp.

(defun c:ssunion (/ ss ssunion ename)

      (defun *error* ( msg )
        (LM:endundo (LM:acdoc))
        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )
  (LM:startundo (LM:acdoc))
  
  (setq ss (ssget '((-4 . "<OR")
		      (0 . "LWPOLYLINE")
		      (0 . "HATCH")
		      (-4 . "OR>")))
	)
  (setq ssunion (ssadd))
  (while (setq ename (ssname ss 0))
    (cond
      ((= "HATCH" (cdr (assoc 0 (entget ename))))
       (command "-hatchedit" ename "b" "r" "n")
       )
       ((= "LWPOLYLINE" (cdr (assoc 0 (entget ename))))
	(command "region" ename "")
	)
      );end cond
    (ssdel ename ss)
    (ssadd (entlast) ssunion )
    )
  (command "union" ssunion "")
  (LM:endundo   (LM:acdoc))
  )

;; Start Undo  -  Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
    (LM:endundo doc)
    (vla-startundomark doc)
)

;; End Undo  -  Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
    (while (= 8 (logand 8 (getvar 'undoctl)))
        (vla-endundomark doc)
    )
)

;; Active Document  -  Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
    (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
    (LM:acdoc)
)
	
       
  

dicra