Compose entities-blocks in a w

sadhu · 发表于 2022-7-6 11:28:10

Is it possible to compose / put-together blocks, entities, text etc in a separate window (e.g. like the block 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.

Lee Mac · 发表于 2022-7-6 11:33:59

Creating a block from the objects is all I can think of at the moment, and this may help in that case:

copy

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

sadhu · 发表于 2022-7-6 11:36:00

I hope you find time to look into 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.

copy

(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 10  pt)                   (cons 40 hgt)                   (cons 1  str)                   (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))

Lee Mac · 发表于 2022-7-6 11:41:04

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:

copy

(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       del  t     ;; 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))

sadhu · 发表于 2022-7-6 11:45:14

That was really great. Just as i wanted.

Thanks a lot.

(.. and where would the easy part be ?)

Lee Mac · 发表于 2022-7-6 11:48:33

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.

sadhu · 发表于 2022-7-6 11:51:34

Here I'm again with another request.

Can you please add rotate/move/scale feature to your code ?

or maybe just a lead.

Thanks.

Lee Mac · 发表于 2022-7-6 11:52:55

I'm not sure I understand - why not just move/scale/rotate the block after its creation?

sadhu · 发表于 2022-7-6 11:57:17

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.

Lee Mac · 发表于 2022-7-6 12:01:32

True, but surely each situation would differ - how would you code all that into the program?

[编程交流] Compose entities-blocks in a w

发表回复

精选推荐