Lt Dan's legs Posted September 29, 2011 Share Posted September 29, 2011 view dxf 330 **use only as a test** (entget (cdr (assoc 330 (reverse (entget (car (entsel "\nSelect hatch : "))))))) Quote Link to comment Share on other sites More sharing options...
alanjt Posted September 29, 2011 Share Posted 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) ) Quote Link to comment Share on other sites More sharing options...
irneb Posted September 29, 2011 Share Posted 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? Quote Link to comment Share on other sites More sharing options...
luiscarneirorm Posted September 29, 2011 Author Share Posted 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 Quote Link to comment Share on other sites More sharing options...
alanjt Posted September 29, 2011 Share Posted 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? Quote Link to comment Share on other sites More sharing options...
alanjt Posted September 29, 2011 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
luiscarneirorm Posted September 29, 2011 Author Share Posted 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 Quote Link to comment Share on other sites More sharing options...
GP_ Posted September 29, 2011 Share Posted 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) ) Quote Link to comment Share on other sites More sharing options...
pBe Posted September 30, 2011 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
luiscarneirorm Posted September 30, 2011 Author Share Posted 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 Quote Link to comment Share on other sites More sharing options...
pBe Posted October 1, 2011 Share Posted 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 Quote Link to comment Share on other sites More sharing options...
luiscarneirorm Posted October 3, 2011 Author Share Posted 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 Quote Link to comment Share on other sites More sharing options...
pBe Posted October 3, 2011 Share Posted 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? Quote Link to comment Share on other sites More sharing options...
luiscarneirorm Posted October 3, 2011 Author Share Posted 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... Quote Link to comment Share on other sites More sharing options...
pBe Posted October 3, 2011 Share Posted October 3, 2011 (edited) 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 Quote Link to comment Share on other sites More sharing options...
pBe Posted October 3, 2011 Share Posted October 3, 2011 (edited) 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 Quote Link to comment Share on other sites More sharing options...
luiscarneirorm Posted October 3, 2011 Author Share Posted 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 Quote Link to comment Share on other sites More sharing options...
pBe Posted October 3, 2011 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
3dwannab Posted March 2, 2017 Share Posted 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. Quote Link to comment Share on other sites More sharing options...
3dwannab Posted March 3, 2017 Share Posted 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) ) Quote Link to comment Share on other sites More sharing options...
Recommended Posts
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.