how to select the Hatch boundaries

September 29, 2011

view dxf 330

**use only as a test**

 
(entget (cdr (assoc 330 (reverse (entget (car (entsel "\nSelect hatch : ")))))))

September 29, 2011

Quick and dirty...

(defun c:Test (/ _2dpt layer ss i a b ss2 i2 d)

 (vl-load-com)

 (setq layer '(8 . "CHEIO"))

 (defun _2dpt (pt) (list (car pt) (cadr pt) 0.))

 (if (setq ss (ssget '((0 . "HATCH"))))
   (repeat (setq i (sslength ss))
     (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'a 'b)
     (if (setq ss2
                (apply 'ssget
                       (append
                         (list "_W")
                         (mapcar '(lambda (x) (trans (_2dpt (vlax-safearray->list x)) 0 1)) (list a b))
                         '(((0 . "~HATCH,ARC,CIRCLE,LINE,LWPOLYLINE")))
                       )
                )
         )
       (repeat (setq i2 (sslength ss))
         (entmod (subst layer (assoc 8 (setq d (entget (ssname ss2 (setq i2 (1- i2)))))) d))
       )
     )
   )
 )
 (princ)
)

September 29, 2011

That only works if the hatch is associative. See why I said it's extremely difficult?

The only way I can think of to perform this on non-associative hatches is to generate the boundary as per your codes. But then run something similar to what occurs inside OverKill to find overlapping entities. Delete the temporary boundary and select the entities which was overlapping with it. But it would be a hit-n-mis approach at best.

Edit: Sorry alan, I didn't see your post. What happens if the hatch looks like the one in post #7?

September 29, 2011

Quick and dirty...

(defun c:Test (/ _2dpt layer ss i a b ss2 i2 d)

 (vl-load-com)

 (setq layer '(8 . "CHEIO"))

 (defun _2dpt (pt) (list (car pt) (cadr pt) 0.))

 (if (setq ss (ssget '((0 . "HATCH"))))
   (repeat (setq i (sslength ss))
     (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'a 'b)
     (if (setq ss2
                (apply 'ssget
                       (append
                         (list "_W")
                         (mapcar '(lambda (x) (trans (_2dpt (vlax-safearray->list x)) 0 1)) (list a b))
                         '(((0 . "~HATCH,ARC,CIRCLE,LINE,LWPOLYLINE")))
                       )
                )
         )
       (repeat (setq i2 (sslength ss))
         (entmod (subst layer (assoc 8 (setq d (entget (ssname ss2 (setq i2 (1- i2)))))) d))
       )
     )
   )
 )
 (princ)
)

seems to me that this will be very useful... but when I have a hatch with an island in without hatch, do not redo the two limits

September 29, 2011

seems to me that this will be very useful... but when I have a hatch with an island in without hatch, do not redo the two limits

Um, what?

September 29, 2011

Edit: Sorry alan, I didn't see your post. What happens if the hatch looks like the one in post #7?

Just saw your edit.

It depends on if there's a hatch boundary for it. Mine isn't creating one, just selecting any possibles, but I'm using a window selection over crossing to possibly remove issues of selecting curves that aren't a portion of the hatch boundary.

September 29, 2011

Um, what?

Sorry, my English it's too too bad... :oops:

maybe if you see these examples you understand wath as i said.

i put some notes in the drawing 1 too explain my problem.

once again the drawing 2 it's my goal. so far I use the function too recreate the boundaries and after i delete the old boundaries(if exist) and the hatch's like this

original_2.dxf

original_1.dxf

September 29, 2011

Code is not too elegant, but should work on not curved boundary with hatch.

For boundary with curves giving up.


(defun C:TEST (/ cmd TOT i H1 B1 B2 VERT LIST_V ALL n)
   (vl-load-com)
   (setq olderr  *error*  *error* myerror)
   (command "_UNDO" "_BEGIN")
   (setq cmd (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   (if (not (tblsearch "LAYER" "cheio"))
       (progn
           (alert "layer \"cheio\" does not exist")
           (exit)
       )
   )    
   (prompt "\nSelect Objects...")
   (setq TOT (ssget '((0 . "HATCH"))))
   (setq i -1)
   (repeat (sslength TOT)
       (setq H1 (ssname TOT (setq i (1+ i))))
       (command "_-HATCHEDIT" H1 "_B" "_P" "_N")
       (setq B1 (entlast))
       (command "OFFSET" "0.0001" B1 "1000000,1000000" "")
       (setq B2 (entlast))
       (setq VERT (vlax-get (vlax-ename->vla-object B2) 'Coordinates))
       (setq LIST_V nil)
       (repeat (/ (length VERT) 2)
           (setq LIST_V (cons (list (car VERT) (cadr VERT)) LIST_V))
           (setq VERT (cddr VERT))
       )
       (setq ALL (ssdel B1 (ssget "_WP" LIST_V)))
       (entdel B2)
       (setq n -1)
       (repeat (sslength ALL)
           (entdel (ssname ALL (setq n (1+ n))))
       )
       (vla-put-layer (vlax-ename->vla-object B1) "cheio")
   )
   (command "_UNDO" "_END")
   (setvar "CMDECHO" cmd)
   (princ)
)
(defun myerror (s)
   (setq *error* olderr)
   (prompt "\n ") (prompt "\n ") (prompt "\n ")
   (princ "Function canceled. ")
   (command "_UNDO" "_END")    
   (setvar "CMDECHO" CMD)
   (princ)
)

September 30, 2011

Bottom line, recreate boundary for selected hatch,

No Boundary---> Create and move to "cheio" layer

Existing Boundary found --> move to "cheio" layer

You can combine Alanjt's and GP_'s code.

Easiest way would be recreate boundary regardless if the boundary exists or not while current layer is "cheio" ,

Erase objects utilizing filters to exclude "HATCH" and layer ""cheio", including hatch within thefilter is important as an exisitng boundary may have the same layer as the hatch entity, keep in mind that there are no entities on "cheio" layer to start with for this to be effective.

September 30, 2011

Code is not too elegant, but should work on not curved boundary with hatch.

For boundary with curves giving up.


(defun C:TEST (/ cmd TOT i H1 B1 B2 VERT LIST_V ALL n)
   (vl-load-com)
   (setq olderr  *error*  *error* myerror)
   (command "_UNDO" "_BEGIN")
   (setq cmd (getvar "CMDECHO"))
   (setvar "CMDECHO" 0)
   (if (not (tblsearch "LAYER" "cheio"))
       (progn
           (alert "layer \"cheio\" does not exist")
           (exit)
       )
   )    
   (prompt "\nSelect Objects...")
   (setq TOT (ssget '((0 . "HATCH"))))
   (setq i -1)
   (repeat (sslength TOT)
       (setq H1 (ssname TOT (setq i (1+ i))))
       (command "_-HATCHEDIT" H1 "_B" "_P" "_N")
       (setq B1 (entlast))
       (command "OFFSET" "0.0001" B1 "1000000,1000000" "")
       (setq B2 (entlast))
       (setq VERT (vlax-get (vlax-ename->vla-object B2) 'Coordinates))
       (setq LIST_V nil)
       (repeat (/ (length VERT) 2)
           (setq LIST_V (cons (list (car VERT) (cadr VERT)) LIST_V))
           (setq VERT (cddr VERT))
       )
       (setq ALL (ssdel B1 (ssget "_WP" LIST_V)))
       (entdel B2)
       (setq n -1)
       (repeat (sslength ALL)
           (entdel (ssname ALL (setq n (1+ n))))
       )
       (vla-put-layer (vlax-ename->vla-object B1) "cheio")
   )
   (command "_UNDO" "_END")
   (setvar "CMDECHO" cmd)
   (princ)
)
(defun myerror (s)
   (setq *error* olderr)
   (prompt "\n ") (prompt "\n ") (prompt "\n ")
   (princ "Function canceled. ")
   (command "_UNDO" "_END")    
   (setvar "CMDECHO" CMD)
   (princ)
)

is exactly one function of this genre that I need, but it is only possible for rectangular hatch's not me is very useful :ouch:

but thank you for your interest

October 1, 2011

Try This

(defun c:ReBound ( / loops layerN HObjts Hobj_ Hobj_VLA lpNum)
(defun Loops (lpn Vlnme EntN Lynm / BndL)
(vla-GetLoopAt Vlnme  (1- lpn) 'lp)
(if (vl-catch-all-error-p
   (setq BndL (vl-catch-all-apply
         'vlax-safearray->list
         (list lp)
       )
   )
 )
 (command "_-HATCHEDIT" EntN "_B" "_P" "_Y")
 (foreach itm BndL
    (vla-put-layer  itm Lynm))
  )
 )
 
  (setq  layerN "CHEIO")
  (if (not (tblsearch "LAYER" layerN))
  (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
                (cons 2 layerN)
  (cons 70  0)     
                (cons 62 1))))
  (setvar 'Clayer layerN)
       (setvar 'Cmdecho 0)    
  (prompt "\nSelect Hatch for Boundary:")
  (setq HObjts (ssget ":L" '((0 . "HATCH"))))
   (repeat (setq i (sslength HObjts))
    (setq Hobj_ (ssname HObjts (setq i (1- i))))
      (setq Hobj_VLA  (vlax-ename->vla-object Hobj_))
           (if (=  (setq lpNum (vla-get-numberofloops Hobj_VLA)) 1)
            (loops lpNum Hobj_VLA Hobj_ layerN)
           (progn
     (setq lp_ 0) 
            (repeat lpNum
        (loops (setq lp_ (1+ lp_)) Hobj_VLA Hobj_ layerN))
     )
           )
   )
 (princ)
 )

HTH

October 3, 2011

Try This

(defun c:ReBound ( / loops layerN HObjts Hobj_ Hobj_VLA lpNum)
(defun Loops (lpn Vlnme EntN Lynm / BndL)
(vla-GetLoopAt Vlnme  (1- lpn) 'lp)
(if (vl-catch-all-error-p
   (setq BndL (vl-catch-all-apply
         'vlax-safearray->list
         (list lp)
       )
   )
 )
 (command "_-HATCHEDIT" EntN "_B" "_P" "_Y")
 (foreach itm BndL
    (vla-put-layer  itm Lynm))
  )
 )
 
  (setq  layerN "CHEIO")
  (if (not (tblsearch "LAYER" layerN))
  (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
                (cons 2 layerN)
  (cons 70  0)     
                (cons 62 1))))
  (setvar 'Clayer layerN)
       (setvar 'Cmdecho 0)    
  (prompt "\nSelect Hatch for Boundary:")
  (setq HObjts (ssget ":L" '((0 . "HATCH"))))
   (repeat (setq i (sslength HObjts))
    (setq Hobj_ (ssname HObjts (setq i (1- i))))
      (setq Hobj_VLA  (vlax-ename->vla-object Hobj_))
           (if (=  (setq lpNum (vla-get-numberofloops Hobj_VLA)) 1)
            (loops lpNum Hobj_VLA Hobj_ layerN)
           (progn
     (setq lp_ 0) 
            (repeat lpNum
        (loops (setq lp_ (1+ lp_)) Hobj_VLA Hobj_ layerN))
     )
           )
   )
 (princ)
 )

HTH

Not delete the old boundaries

October 3, 2011

Oh i see.

I tested the code on your posted DXF sample

I noticed that the color of the boundaries of the "letters" hatch are white and not by layer. it worked well with that sample.

I'll take a look at the other samples.

Which sample did you try the code on Luis?

EDIT: I noticed that the hatch on sample hatch1.dxf are not associative

We'll try to find a way around this. but next time make sure when you use associative OK?

October 3, 2011

Oh i see.

I tested the code on your posted DXF sample

I noticed that the color of the boundaries of the "letters" hatch are white and not by layer. it worked well with that sample.

I'll take a look at the other samples.

Which sample did you try the code on Luis?

EDIT: I noticed that the hatch on sample hatch1.dxf are not associative

We'll try to find a way around this. but next time make sure when you use associative OK?

I try with the hatch1.dxf file...

My problem is that the drawings are not made by us, we received them from other companies...

October 3, 2011

Ok. I found a way. I understand your problem regarding "drawings not made by us"

I' will experiment with 3 different apporach and then we'll see after that.

Again be patient Luis..

Edited October 3, 2011 by pBe

October 3, 2011

Ok here's draft #2

(defun c:ReBound ( / loops layerN HObjts Hobj_ Hobj_VLA lpNum)
(defun Loops (lpn Vlnme EntN Lynm / BndL)
(vla-GetLoopAt Vlnme  lpn 'lp)
(if (vl-catch-all-error-p
   (setq BndL (vl-catch-all-apply
         'vlax-safearray->list
         (list lp)
       )
   )
 )
 (progn 
 (command "_-HATCHEDIT" EntN "_B" "_P" "_Y")
 (AT:Test EntN))
 (foreach itm BndL
    (vla-put-layer  itm Lynm))
  )
 )

  (setq  layerN "CHEIO")
  (if (not (tblsearch "LAYER" layerN))
  (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
                (cons 2 layerN)
  (cons 70  0)     
                (cons 62 1))))
  (setvar 'Clayer layerN)
       (setvar 'Cmdecho 0)    
  (prompt "\nSelect Hatch for Boundary:")
  (setq HObjts (ssget ":L" '((0 . "HATCH"))))
   (repeat (setq i (sslength HObjts))
    (setq Hobj_ (ssname HObjts (setq i (1- i))))
      (setq Hobj_VLA  (vlax-ename->vla-object Hobj_))
           (if (=  (setq lpNum (vla-get-numberofloops Hobj_VLA)) 1)
            (loops 0 Hobj_VLA Hobj_ layerN)
           (progn
     (setq lp_ -1) 
            (repeat lpNum
        (loops (setq lp_ (1+ lp_)) Hobj_VLA Hobj_ layerN))
     )
           )
   )
 (princ)
 )
(defun AT:Test (ent / _2dpt layer ss i a b ss2 i2 d)
;;;(defun c:Test (/ _2dpt layer ss i a b ss2 i2 d)  
(vl-load-com)
;;;(setq layer '(8 . "CHEIO"))
(defun _2dpt (pt) (list (car pt) (cadr pt) 0.))
;;;  (if (setq ss (ssget '((0 . "HATCH"))))
;;;    (repeat (setq i (sslength ss))
;;;      (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'a 'b)
  (vla-getboundingbox (vlax-ename->vla-object ent) 'a 'b)
     (if (setq ss2
                (apply 'ssget
                       (append
                         (list "_W")
                         (mapcar '(lambda (x) (trans (_2dpt (vlax-safearray->list x)) 0 1)) (list a b))
                         '(((0 . "~HATCH,ARC,CIRCLE,LINE,LWPOLYLINE")(8 . "~CHEIO")))
                       )
                )
         )
;;;        (repeat (setq i2 (sslength ss))
(repeat (setq i2 (sslength ss2))
  (entdel (ssname ss2 (setq i2 (1- i2))))
;;;          (entmod (subst layer (assoc 8 (setq d (entget (ssname ss2 (setq i2 (1- i2)))))) d))
;;;        )
;;;      )
   )
 )
 (princ)
)

NOTE: Dont use this on NON Associative Separate Hatch type as of yet, i'm working on that now

After evaluating the condition regarding the item above (highlighted in blue) , i came up with a suggestion.

Run a routine to separate this type of hatch prior to the main routine

(defun c:SepHatch (/ HObjts H1 h1_ent)
 (setq HObjts (ssget ":L" '((0 . "HATCH"))))
 (repeat (sslength HObjts)
   (setq H1  (ssname HObjts 0)
  H1_ent (entget H1)
   )
   (if (and (> (cdr (assoc 91 H1_ent)) 1)
     (zerop (cdr (assoc 71 H1_ent)))
)
     (command "_-HATCHEDIT" H1 "_H")
   )
   (setq HObjts (ssdel H1 HObjts))
 )
)

We can incorporate this on the main routine but it will surely slow the process.

HTH

Edited October 3, 2011 by pBe

October 3, 2011

Ok here's draft #2

(defun c:ReBound ( / loops layerN HObjts Hobj_ Hobj_VLA lpNum)
(defun Loops (lpn Vlnme EntN Lynm / BndL)
(vla-GetLoopAt Vlnme  lpn 'lp)
(if (vl-catch-all-error-p
   (setq BndL (vl-catch-all-apply
         'vlax-safearray->list
         (list lp)
       )
   )
 )
 (progn 
 (command "_-HATCHEDIT" EntN "_B" "_P" "_Y")
 (AT:Test EntN))
 (foreach itm BndL
    (vla-put-layer  itm Lynm))
  )
 )

  (setq  layerN "CHEIO")
  (if (not (tblsearch "LAYER" layerN))
  (entmake (list (cons 0 "LAYER")
                (cons 100 "AcDbSymbolTableRecord")
                (cons 100 "AcDbLayerTableRecord")
                (cons 2 layerN)
  (cons 70  0)     
                (cons 62 1))))
  (setvar 'Clayer layerN)
       (setvar 'Cmdecho 0)    
  (prompt "\nSelect Hatch for Boundary:")
  (setq HObjts (ssget ":L" '((0 . "HATCH"))))
   (repeat (setq i (sslength HObjts))
    (setq Hobj_ (ssname HObjts (setq i (1- i))))
      (setq Hobj_VLA  (vlax-ename->vla-object Hobj_))
           (if (=  (setq lpNum (vla-get-numberofloops Hobj_VLA)) 1)
            (loops 0 Hobj_VLA Hobj_ layerN)
           (progn
     (setq lp_ -1) 
            (repeat lpNum
        (loops (setq lp_ (1+ lp_)) Hobj_VLA Hobj_ layerN))
     )
           )
   )
 (princ)
 )
(defun AT:Test (ent / _2dpt layer ss i a b ss2 i2 d)
;;;(defun c:Test (/ _2dpt layer ss i a b ss2 i2 d)  
(vl-load-com)
;;;(setq layer '(8 . "CHEIO"))
(defun _2dpt (pt) (list (car pt) (cadr pt) 0.))
;;;  (if (setq ss (ssget '((0 . "HATCH"))))
;;;    (repeat (setq i (sslength ss))
;;;      (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'a 'b)
  (vla-getboundingbox (vlax-ename->vla-object ent) 'a 'b)
     (if (setq ss2
                (apply 'ssget
                       (append
                         (list "_W")
                         (mapcar '(lambda (x) (trans (_2dpt (vlax-safearray->list x)) 0 1)) (list a b))
                         '(((0 . "~HATCH,ARC,CIRCLE,LINE,LWPOLYLINE")(8 . "~CHEIO")))
                       )
                )
         )
;;;        (repeat (setq i2 (sslength ss))
(repeat (setq i2 (sslength ss2))
  (entdel (ssname ss2 (setq i2 (1- i2))))
;;;          (entmod (subst layer (assoc 8 (setq d (entget (ssname ss2 (setq i2 (1- i2)))))) d))
;;;        )
;;;      )
   )
 )
 (princ)
)

NOTE: Dont use this on NON Associative Separate Hatch type as of yet, i'm working on that now

After evaluating the condition regarding the item above (highlighted in blue) , i came up with a suggestion.

Run a routine to separate this type of hatch prior to the main routine

(defun c:SepHatch (/ HObjts H1 h1_ent)
 (setq HObjts (ssget ":L" '((0 . "HATCH"))))
 (repeat (sslength HObjts)
   (setq H1  (ssname HObjts 0)
  H1_ent (entget H1)
   )
   (if (and (> (cdr (assoc 91 H1_ent)) 1)
     (zerop (cdr (assoc 71 H1_ent)))
)
     (command "_-HATCHEDIT" H1 "_H")
   )
   (setq HObjts (ssdel H1 HObjts))
 )
)

We can incorporate this on the main routine but it will surely slow the process.

HTH

is almost near perfect:)

to have only detected a fault, I'll put here the design which I think is the easiest way to explain.

Edit: sorry, I had not seen your edit, but the original function seemed to work well

original_3.dxf

October 3, 2011

I noticed that fault too. but then again. the result is only as good as the information you get from "drawings are not made by us, we received them from other companies... "

Having said that. problems like that cannot be avoided especially when you dont have complete control of the way the drawings are created.

March 2, 2017

Quick and dirty...

(defun c:Test (/ _2dpt layer ss i a b ss2 i2 d)

 (vl-load-com)

 (setq layer '(8 . "CHEIO"))

 (defun _2dpt (pt) (list (car pt) (cadr pt) 0.))

 (if (setq ss (ssget '((0 . "HATCH"))))
   (repeat (setq i (sslength ss))
     (vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'a 'b)
     (if (setq ss2
                (apply 'ssget
                       (append
                         (list "_W")
                         (mapcar '(lambda (x) (trans (_2dpt (vlax-safearray->list x)) 0 1)) (list a b))
                         '(((0 . "~HATCH,ARC,CIRCLE,LINE,LWPOLYLINE")))
                       )
                )
         )
       (repeat (setq i2 (sslength ss))
         (entmod (subst layer (assoc 8 (setq d (entget (ssname ss2 (setq i2 (1- i2)))))) d))
       )
     )
   )
 )
 (princ)
)

Hi Alan,

This code is something similar to what i'm after only.

I was hoping to have it so my hatch objects are already selected via other lisp functions I have for filtering hatches and then run the command and so selects the boundaries of those hatches.

Note: All boundaries have associative hatches to them.

March 3, 2017

I've tried to get this to work with my limited knowledge but it only works for one of the selected hatches.

It works if I have the object selected first which is what I was after.

I just need the functionality of it working with more than one hatch selection.

Thanks.

Code I've so far:

(defun c:Test (/ _2dpt ss1 ss2 ss3 a b i1 i2 )

(vl-load-com)

(defun _2dpt (pt) (list (car pt) (cadr pt) 0.))

(if
	(setq ss1 (ssget '((0 . "HATCH"))))
	(repeat
		(setq i1 (sslength ss1))

		(vla-getboundingbox (vlax-ename->vla-object (ssname ss1 (setq i1 (1- i1)))) 'a 'b)

		(if (setq ss2
			(apply 'ssget
				(append
					(list "_W")
					(mapcar '(lambda (x) (trans (_2dpt (vlax-safearray->list x)) 0 1)) (list a b))
					'(((0 . "~HATCH,ARC,CIRCLE,LINE,LWPOLYLINE")))
					)
				)
			)

		(repeat (setq i2 (sslength ss2))

			(setq ss3 (ssname ss2 (setq i2 (1- i2))))
			(command "_.Pselect" ss3 "")

			)
		)
		)
	)

(command "._regen")(princ)

)

Sign In

how to select the Hatch boundaries

Recommended Posts

Lt Dan's legs

Top Posters In This Topic

Popular Days

Top Posters In This Topic

Popular Days

Popular Posts

3dwannab

Posted Images

alanjt

irneb

luiscarneirorm

alanjt

alanjt

luiscarneirorm

GP_

pBe

luiscarneirorm

pBe

luiscarneirorm

pBe

luiscarneirorm

pBe

pBe

luiscarneirorm

pBe

3dwannab

3dwannab

Join the conversation

3dwannab

Tutorials

Forums

Activity