Lisp for Hatch Boundary

[Sandeep RC]

Can anybody please provide me a lisp for creating multiple hatch OUTER BOUNDARY as a closed polyline DIRECTLY.

 

The inbuilt functionality in Autocad Creates the boundary as a region which i have to explode and join again, which is not convenient for me because of too many data around that boundary.

I want only OUTER boundary of hatch as a closed polyline. please help.

[steven-g]

Hatchgenerateboundary, creates closed polylines?

[Sandeep RC]

i have bunch of small closed polyline areas just like a spider web, i have to combine few of  them, form a groups based on their areas, so after hatching i want outer boundaries only.

above command creates internal individual boundaries, which i dont want.

 

see the image for your ref.

[dlanorh]

an oldy but goody

 

;;
;; Gilles (gile) 22 March 2010 
;; Recreer les contours a partir de hachures 
;; ReCreate Boundaries from Hatches 
;; 

(defun c:ReBound (/ n ss ent)
  (if (and (setq n -1) (setq ss (ssget '((0 . "HATCH")))))
    (while (setq ent (ssname ss (setq n (1+ n))))
      ( command  "_hatchedit"  ent  "_boundary"  "_polyline"  "_yes" )
    )
  )
  (princ)
) 
 

 

[Sandeep RC]

Its good but it creates internal boundaries as well which i dont want.

please look at the image above. i have hatched the area 533/1, 533/2, 530/7 & 530/1.2.

so i want lisp that creates only the outer boundary as a Polyline of this hatch. the above lisp creates internal boundaries as well which i dont want.

can you please help me with that?

[tombu]

Try

;;; AssHatch.lsp requires Hatchutil.lsp which came with Express Tools.
;;; associate a selection of Hatch entities.
;;; by: Tom Beauford
;;; BeaufordT@LeonCountyFL.gov
;;; LEON COUNTY PUBLIC WORKS ENGINEERING SECTION
(defun c:AssHatch ( / htch ss e# ent elist)
  (setq htch (car(entsel "Select Hatch"))
  )
  (if(not acet-hatch-remake)(load "Hatchutil"))
  (princ "\n\n")
  (acet-hatch-boundary-assoc-db htch (list (car(entsel)))T)
)

 

[Sandeep RC]

@ Tombu,

 

Not working bro. after giving command & selecting hatch its says select object. and there after error comes 'bad argument'

 

do i neet to make any extra settings for this lisp to work?

[dlanorh]

A sample drawing  saved as Autocad 2007 (for me) would help.

[dlanorh]

OK. Try This. You can only select HATCHES at the prompt, and I'm counting on the fact that the boundary command creates the outermost boundary (a polyline representing the circle) last.

 

(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (cons (vlax-safearray->list llp) ls1)
                  ls2 (cons (vlax-safearray->list urp) ls2)
            )
        )
    )
    (if (and ls1 ls2)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    )
)

(vl-load-com)

(defun rh:em_circle (pt r) (entmakex (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 r))))

(defun c:test ( / *error* sv_lst sv_vals c_doc i lst ss ent lst bb_lst m_pt r bss i_pt)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : ( " msg " ) occurred.")))
    (princ)
  );end_*error*_defun

  (setq sv_lst (list 'cmdecho 'osmode)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
  );end_setq

  (mapcar 'setvar sv_lst (list 0 0))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (prompt "\nSelect Hatches : ")
  (setq ss (ssget '((0 . "HATCH"))))
  (cond (ss
          (repeat (setq i (sslength ss))
            (setq ent (ssname ss (setq i (1- i))))
            (command  "_hatchedit" ent "_boundary" "_polyline" "_yes" )
            (setq ent (entlast)
                  lst (cons ent lst)
            );end_setq
          );end_repeat
          (setq bb_lst (LM:ssboundingbox ss)
                m_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car bb_lst) (cadr bb_lst))
                r (1+ (fix (distance m_pt (car bb_lst))))
                lst (cons (setq ent (rh:em_circle m_pt r)) lst)
                i_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car bb_lst) (vlax-curve-getclosestpointto ent (car bb_lst)))
                bss (ssadd)
          );end_setq
          (foreach e lst (ssadd e bss))
          (command "-boundary" "_A" "_I" "_Y" "_B" "_N" bss "" "" i_pt "")
          (setq lst (cons (entlast) lst))
          (foreach e lst (entdel e))
        )
  );end_cond

  (vla-regen c_doc acActiveViewport)
  (mapcar 'setvar sv_lst sv_vals)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun

 

[Sandeep RC]

above lisp creates internal boundaries as well. please check the attached sample file saved in 2010. hatch all or more than 2 rectangles next to each other, and then see if you can create a hatch OUTER boundary directly as a polyline.

 

Thank you.

Sample.dwg

[dlanorh]

I beg to differ, it doesn't create any inner boundaries. If I hatch say 4 of the plots in you sample drawing and remove the existing polylines around the plots, the lisp only creates an outer boundary of the 4 hatched areas. Please see attached drawing for clarity. Are the hatches neccessary? Do you just want to remove existing plot boundaries and replace with a new?

Sample(2).dwg

Edited January 9, 2020 by dlanorh
Missed attachment

[Roy_043]

Below is a solution based on the 'classic' temporary regions approach.

(defun KGA_Conv_EnameList_To_Pickset (lst / ret)
  (setq ret (ssadd))
  (foreach enm lst (if (not (vlax-erased-p enm)) (ssadd enm ret)))
  (if (/= 0 (sslength ret)) ret)
)

(defun KGA_Conv_Pickset_To_EnameList (ss / i ret)
  (if ss
    (repeat (setq i (sslength ss))
      (setq ret (cons (ssname ss (setq i (1- i))) ret))
    )
  )
)

(defun KGA_Sys_ObjectOwner (obj)
  (vla-objectidtoobject (vla-get-database obj) (vla-get-ownerid obj))
)

(defun UnionPolylines_CreateRegions (enmLst)
  (mapcar
    'vlax-vla-object->ename
    (vlax-invoke
      (KGA_Sys_ObjectOwner (vlax-ename->vla-object (car enmLst)))
      'addregion
      (mapcar 'vlax-ename->vla-object enmLst)
    )
  )
)


(defun c:UnionPolylines ( / doc oldClayer ss ssOut tmpLyr tmpLyrNme)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-endundomark doc)
  (vla-startundomark doc)
  (setvar 'cmdecho 0)
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&=") (70 . 1))))
    (progn
      (while (tblsearch "layer" (setq tmpLyrNme (strcat "UnionPolylines_" (rtos (getvar 'cdate) 2 8))))
      )
      (setq tmpLyr (vla-add (vla-get-layers (vla-get-activedocument (vlax-get-acad-object))) tmpLyrNme))
      (setq oldClayer (getvar 'clayer))
      (setvar 'clayer tmpLyrNme)
      (command
        "_.union"
        (KGA_Conv_EnameList_To_Pickset
          (UnionPolylines_CreateRegions (KGA_Conv_Pickset_To_EnameList ss))
        )
        ""
      )
      (while (setq ss (ssget "_X" (list '(0 . "REGION") (cons 8 tmpLyrNme))))
        (command "_.explode" ss)
      )
      (command "_.join" (ssget "_X" (list (cons 8 tmpLyrNme))) "")
      (command "_.chprop" (setq ssOut (ssget "_X" (list '(0 . "LWPOLYLINE") (cons 8 tmpLyrNme)))) "" "_layer" oldClayer "")
      (if (setq ss (ssget "_X" (list (cons 8 tmpLyrNme))))
        (progn
          (princ "\nError: unexpected error ")
          (command "_.erase" ss "")
        )
      )
      (setvar 'clayer oldClayer)
      (vla-delete tmpLyr)
      (sssetfirst nil ssOut)
    )
  )
  (setvar 'cmdecho 1)
  (vla-endundomark doc)
  (princ)
)

 

[Sandeep RC]

1 hour ago, dlanorh said:

I beg to differ, it doesn't create any inner boundaries. If I hatch say 4 of the plots in you sample drawing and remove the existing polylines around the plots, the lisp only creates an outer boundary of the 4 hatched areas. Please see attached drawing for clarity. Are the hatches neccessary? Do you just want to remove existing plot boundaries and replace with a new?

Sample(2).dwg 437.36 kB · 0 downloads

 

hatches are not necessary and can be deleted after wards but i need plot boundaries to remain intact.

[dlanorh]

So something like this.

 

(defun LM:ssboundingbox ( sel / idx llp ls1 ls2 obj urp )
    (repeat (setq idx (sslength sel))
        (setq obj (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))))
        (if (and (vlax-method-applicable-p obj 'getboundingbox)
                 (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-getboundingbox (list obj 'llp 'urp))))
            )
            (setq ls1 (cons (vlax-safearray->list llp) ls1)
                  ls2 (cons (vlax-safearray->list urp) ls2)
            )
        )
    )
    (if (and ls1 ls2)
        (mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list ls1 ls2))
    )
)

(vl-load-com)

(defun rh:em_circle (pt r) (entmakex (list '(0 . "CIRCLE") (cons 10 pt) (cons 40 r))))

(defun c:test ( / *error* sv_lst sv_vals c_doc c_lyrs i lst ss ent bb_lst m_pt r bss i_pt)

  (defun *error* ( msg )
    (mapcar 'setvar sv_lst sv_vals)
    (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
    (if (not (wcmatch (strcase msg) "*BREAK*,*CANCEL*,*EXIT*")) (princ (strcat "\nOops an Error : ( " msg " ) occurred.")))
    (princ)
  );end_*error*_defun

  (setq sv_lst (list 'cmdecho 'osmode 'clayer)
        sv_vals (mapcar 'getvar sv_lst)
        c_doc (vla-get-activedocument (vlax-get-acad-object))
        c_lyrs (vla-get-layers c_doc)
  );end_setq
  
  (if (not (tblsearch "LAYER" "O-BOUNDARIES")) (vlax-put-property (vla-add c_lyrs "O-BOUNDARIES") 'color 5))

  (mapcar 'setvar sv_lst (list 0 0 "O-BOUNDARIES"))
  
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (vla-startundomark c_doc)

  (prompt "\nSelect Boundary Polylines : ")
  (setq ss (ssget '((0 . "LWPOLYLINE"))))
  (cond (ss
          (repeat (setq i (sslength ss))
            (setq ent (ssname ss (setq i (1- i)))
                  lst (cons ent lst)
            );end_setq
          );end_repeat
          (setq bb_lst (LM:ssboundingbox ss)
                m_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car bb_lst) (cadr bb_lst))
                r (1+ (fix (distance m_pt (car bb_lst))))
                lst (cons (setq ent (rh:em_circle m_pt r)) lst)
                i_pt (mapcar '(lambda (x y) (/ (+ x y) 2.0)) (car bb_lst) (vlax-curve-getclosestpointto ent (car bb_lst)))
                bss (ssadd)
          );end_setq
          (foreach e lst (ssadd e bss))
          (command "-boundary" "_A" "_I" "_Y" "_B" "_N" bss "" "" i_pt "")
          (foreach e (list (entlast) ent) (entdel e))
        )
  );end_cond

  (vla-regen c_doc acActiveViewport)
  (mapcar 'setvar sv_lst sv_vals)
  (if (and c_doc (= 8 (logand 8 (getvar 'UNDOCTL)))) (vla-endundomark c_doc))
  (princ)
);end_defun

 

Just select the boundary polylines you want to include in the new boundary. The new boundary is place in a layer called "O-BOUNDARIES" colour 5. This is created if it doesn't exist.

Edited January 9, 2020 by dlanorh