Jump to content

how to select the Hatch boundaries


luiscarneirorm

Recommended Posts

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

Um, what? :?

 

Sorry, my English it's too too bad... :oops::oops::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

select_to_delet.JPG

original_2.dxf

original_1.dxf

Link to comment
Share on other sites

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

 

For boundary with curves giving up. :oops:

 

 

 


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

Link to comment
Share on other sites

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.

Link to comment
Share on other sites

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

 

For boundary with curves giving up. :oops:

 

 

 


(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::ouch::ouch:

 

but thank you for your interest

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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?

Link to comment
Share on other sites

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

Link to comment
Share on other sites

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 by pBe
Link to comment
Share on other sites

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 by pBe
Link to comment
Share on other sites

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

Link to comment
Share on other sites

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.

 

:)

Link to comment
Share on other sites

  • 5 years later...
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.

Link to comment
Share on other sites

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)

)

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...