Compose entities-blocks in a w
Is it possible to compose / put-together blocks, entities, text etc in a separate window (e.g. like theblock editor) and then insert it as a single entity in the drawing ?What I have in mind are the electrical outlet boxes in homes and apartments.These outlet boxes contain one, two or three switches / sockets etc and can be variable.
Have a look at this thread . I was planning to do as in this thread but I got stuck with creating a single entity. Maybe composing in a separate window might be a better idea.
A lead on how this could be done is welcome.
Thanks. Creating a block from the objects is all I can think of at the moment, and this may help in that case:
(defun c:obj2blk (/ BNME ENT I PT SS SUB) ;; Lee Mac~11.02.10 (cond ((not (setq ss (ssget '((0 . "~VIEWPORT")))))) ((while (progn (setq bNme (getstring t "\nSpecify Block Name: ")) (cond ((not (snvalid bNme)) (princ "\n** Invalid Block Name **")) ((tblsearch "BLOCK" bNme) (princ "\n** Block Already Exists **")))))) ((not (setq i -1 pt (getpoint "\nSpecify Base Point: ")))) (t (entmake (list (cons 0 "BLOCK") (cons 10 pt) (cons 2 bNme) (cons 70 0))) (while (setq ent (ssname ss (setq i (1+ i)))) (entmake (entget ent)) (and (= 1 (cdr (assoc 66 (entget (setq sub ent))))) (while (not (eq "SEQEND" (cdr (assoc 0 (entget (setq sub (entnext sub))))))) (entmake (entget sub))) (entmake (entget sub))) (entdel ent)) (entmake (list (cons 0 "ENDBLK") (cons 8 "0"))) (entmake (list (cons 0 "INSERT") (cons 2 bNme) (cons 10 pt))))) (princ)) I hope you find time to lookinto the code below :
I tried to put together the box code and the obj2blk. I get strange results. When I launch the second time (the first time it works) it gets into a loop - I think.
(fools rush in where angles ..)
Besides I need to add "num" to the final block as an attribute.
(defun c:Bf (/ *error* LWPoly Text ENT FLOOR GRP I LAY MA MI NNUM NUM OFFSET POLY PTS SS THGT TOBJ UFLAG)(vl-load-com) ;; Lee Mac~24.02.10 (setq lay "My Boxing Layer" ;; Layer offset 0.01;; Offset thgt 0.08 ;; Text Height ) (defun *error* (msg) (and uFlag (vla-EndUndomark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (defun Line (pt1 pt2) (entmakex (list (cons 0 "LINE") (cons 10 pt1) (cons 11 pt2)))) (defun LWPoly (lst cls) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 8 lay) (cons 90 (length lst)) (cons 70 cls)) (mapcar (function (lambda (p) (cons 10 p))) lst)))) (defun Text (pt hgt str) (entmakex (list (cons 0 "TEXT") (cons 8 lay) (cons 10pt) (cons 40 hgt) (cons 1str) (cons 72 1) (cons 73 2) (cons 11 pt)))) (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))))(if (setq ss (ssget)) (progn (setq uFlag (not (vla-StartUndoMark *doc))) (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc)) (vla-getBoundingbox obj 'Mi 'Ma) (setq pts (cons (vlax-safearray->list Mi) (cons (vlax-safearray->list Ma) pts)))) (vla-delete ss) (setq Mi (apply (function mapcar) (cons 'min pts)) Ma (apply (function mapcar) (cons 'max pts))) (setq Poly (LwPoly (list (list (- (car Mi) offset) (- (cadr Mi) Offset) 0.) (list (- (car Mi) offset) (+ (cadr Ma) offset) 0.) (list (+ (car Ma) offset) (+ (cadr Ma) offset) 0.) (list (+ (car Ma) offset) (- (cadr Mi) offset) 0.)) 1)) (setq num (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "TEXT") (cons 8 lay)))) (progn (while (setq ent (ssname ss (setq i (1+ i)))) (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget ent)))))) (setq floor nNum))) (itoa (1+ floor))) "1")) (setq TObj (Text (list (/ (+ (car Mi) (car Ma)) 2.) (- (cadr Mi) (+ Offset tHgt)) 0.) thgt num)) (if (not (vl-catch-all-error-p (setq Grp (vl-catch-all-apply (function vla-Add) (list (vla-get-Groups *doc) (strcat "BoxNumber_" num)))))) (vla-AppendItems Grp (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject '(0 . 1)) (mapcar (function vlax-ename->vla-object) (list Poly tObj))))) (princ (strcat "\n** Error Creating Group: " (vl-catch-all-error-message Grp) " **"))) (setq uFlag (vla-EndUndoMark *doc))))(princ (strcat "\n the number is:" num)) (setq x1 (- (car Mi) (* 2 offset))) (setq y1 (- (cadr Mi) (* 2 offset))) (setq x2 (+ (car Ma) (* 2 offset))) (setq y2 (- (cadr Ma) (* 2 offset))) (setq pt1 (list x1 y1)) (setq pt2 (list x2 y2)) (line pt1 pt2)(setq ss (ssget "W" pt1 pt2)) (setq bNme "RH_") ; BLOCK IS ALWAYS REDEFINED (setq i -1) (entmake (list (cons 0 "BLOCK") (cons 10 pt1) (cons 2 bNme) (cons 70 0))) (while (setq ent (ssname ss (setq i (1+ i)))) (entmake (entget ent)) (and (= 1 (cdr (assoc 66 (entget (setq sub ent))))) (while (not (eq "SEQEND" (cdr (assoc 0 (entget (setq sub (entnext sub))))))) (entmake (entget sub)) ); WHILE (entmake (entget sub)) );AND (entdel ent) );WHILE (entmake (list (cons 0 "ENDBLK") (cons 8 "0"))) (entmake (list (cons 0 "INSERT") (cons 2 bNme) (cons 10 pt1))) (princ)) I went about it another way - using the Visual LISP method for creating a block, slightly easier in this instance.
Note: another control added to the top:
(defun c:BoxObj (/ *error* BLK DEL ENT FLOOR I LAY MA MI NNUM NUM OBJLST OFFSET PTS SPC SS THGT UFLAG)(vl-load-com) ;; Lee Mac~11.02.10 (setq lay "My Boxing Layer" ;; Layer offset 5.;; Offset thgt 2.5 ;; Text Height delt ;; Delete Original Objects )(defun *error* (msg) (and uFlag (vla-EndUndomark *doc)) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **"))) (princ)) (setq *doc (cond (*doc) ((vla-get-ActiveDocument (vlax-get-acad-object)))) spc(if (or (eq AcModelSpace (vla-get-ActiveSpace *doc)) (eq :vlax-true (vla-get-MSpace *doc))) (vla-get-ModelSpace *doc) (vla-get-PaperSpace *doc)))(if (setq ss (ssget)) (progn (setq uFlag (not (vla-StartUndoMark *doc))) (or (tblsearch "LAYER" lay) (vla-add (vla-get-Layers *doc) lay)) (vlax-for obj (setq ss (vla-get-ActiveSelectionSet *doc)) (setq Objlst (cons obj Objlst)) (vla-getBoundingbox obj 'Mi 'Ma) (setq pts (cons (vlax-safearray->list Mi) (cons (vlax-safearray->list Ma) pts)))) (vla-delete ss) (setq Mi (apply (function mapcar) (cons 'min pts)) Ma (apply (function mapcar) (cons 'max pts))) (setq Blk (vlax-invoke (vla-get-Blocks *doc) 'Add (list (- (car Mi) offset) (- (cadr Mi) Offset) 0.) "*U")) (vla-copyObjects *doc (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbObject (cons 0(1- (length ObjLst)))) ObjLst)) Blk) (vla-put-closed (vlax-invoke blk 'AddLightWeightPolyline (list (- (car Mi) offset) (- (cadr Mi) Offset) (- (car Mi) offset) (+ (cadr Ma) offset) (+ (car Ma) offset) (+ (cadr Ma) offset) (+ (car Ma) offset) (- (cadr Mi) offset))):vlax-true) (setq num (if (setq i -1 floor 1 ss (ssget "_X" (list (cons 0 "INSERT") (cons 8 lay) (cons 66 1)))) (progn (while (setq ent (ssname ss (setq i (1+ i)))) (if (< floor (setq nNum (atoi (cdr (assoc 1 (entget (entnext ent))))))) (setq floor nNum))) (itoa (1+ floor))) "1")) (vlax-invoke blk 'AddAttribute thgt acAttributeModePreset "num" (list (/ (+ (car Mi) (car Ma)) 2.) (- (cadr Mi) (+ Offset tHgt)) 0.) "num" num) (vla-put-layer (vlax-invoke spc 'InsertBlock (list (- (car Mi) offset) (- (cadr Mi) Offset) 0.) (vla-get-Name blk) 1. 1. 1. 0.) lay) (if Del (mapcar (function vla-delete) ObjLst)) (setq uFlag (vla-EndUndoMark *doc)))) (princ)) That was really great. Just as i wanted.
Thanks a lot.
(.. and where would the easy part be ?)
You're welcome Sadhu
Well, it was easier than messing with DXF tables anyway I made the code create anonymous blocks, as I thought this might be better. Here I'm again with another request.
Can you please add rotate/move/scale feature to your code ?
or maybe just a lead.
Thanks. I'm not sure I understand - why not just move/scale/rotate the block after its creation? It is to reduce the number of clicks and increase efficiency.
Each apartment has about 50 blocks to insert. Often, depending on the client, there are between 20-50 apartments in a construction site. And this goes on the whole year round.
So you can imagine how tiring it is. True, but surely each situation would differ - how would you code all that into the program?
页:
[1]
2