Topic: Import Acad Groups into other DWG

[martinle]

Hello I need the help of the Lisp gods in this forum again.
My problem is this: I have a lot of anonymous acad groups in my dwg. Now I need to transfer these groups from one drawing to another drawing. I've been looking all afternoon but haven't really found a solution.
My idea is this: convert all named and anonymous groups to blocks and then copy and paste everything in the other dwg. Then dissolve all blocks that were previously created from the groups and create anonymous groups from them.
Only the top level of a block should be exploded because the original groups also contain blocks that should be recovered.
Would this idea make sense and be feasible?
lg. Martin

[liuhe]

If it were me, my solution would be to select a shape, obtain all the shapes in the group that this shape belongs to, and then copy these elements. You need 4 related functions, one group related function; One is the dbx function (which can read dwg file information without opening the graph, and LeeMac has related functions); One is the copy function vla CopyObjects;
I'm sorry, all of my relevant codes are in Chinese. If you have a basic understanding of LISP, you should be able to understand it by studying it yourself.

The following code should meet your needs

Code: [Select]

;;;========================================================;
;;;取得图元所在的组名                   by yjtdkj2021.08.01;
;;;========================================================;
(GetEntGroupName (car(entsel)))
(defun GetEntGroupName (gpe / el lst a g gpnlst)
  (setq dic (cdr (assoc -1 (dictsearch (namedobjdict) "acad_group"))))
  (setq el (entget gpe))
  (if (setq lst (member '(102 . "{ACAD_REACTORS") el))
    (while (and (setq lst (cdr lst)) (= 330 (car (setq a (car lst)))))
      (if (= "GROUP"
     (cdr (assoc 0 (entget (setq g (cdr a)))))
  )
(setq grp
       (cdadr
(member
   (cons 350 g)
   (reverse (entget dic))
)
       )
)
      )
    )
  )
)

;; Group Entities  -  Lee Mac;; Creates a Group with a given name containing all entities in the supplied list
;; grp - [str] Group name (use "*" for an anonymous group)
;; lst - [lst] List of entities to add to group
;; sel - [bol] If T, group is selectable

(defun LM:groupentities (grp lst sel / dic enx gde gdx tmp)
  (if (setq dic (cdr (assoc -1 (dictsearch (namedobjdict) "acad_group"))))
    (if (setq gdx (dictsearch dic grp)
      gde (cdr (assoc -1 gdx))
)
      (progn
(entmod (append gdx (mapcar '(lambda (x) (cons 340 x)) lst))
)
(foreach ent lst
  (setq enx (entget ent)
tmp (member '(102 . "{ACAD_REACTORS") enx)
  )
  (if tmp
    (setq tmp
   (vl-list*
     (car tmp)
     (cons 330 gde)
     (cdr tmp)
   )
    )
    (setq tmp
   (vl-list*
     '(102 . "{ACAD_REACTORS")
     (cons 330 gde)
     '(102 . "}")
     (cdr (member (assoc 5 enx) enx))
   )
    )
  )
  (entmod
    (append (reverse (member (assoc 5 enx) (reverse enx))) tmp)
  )
)
grp
      )
      (if
(and
  (setq gde
(entmakex
   (list
     '(000 . "GROUP")
     '(102 . "{ACAD_REACTORS")
     (cons 330 dic)
     '(102 . "}")
     (cons 330 dic)
     '(100 . "AcDbGroup")
     (if (wcmatch grp "`*")
       '(070 . 1)
       '(070 . 0)
     )
     (if sel
       '(071 . 1)
       '(071 . 0)
     )
   )
)
  )
  (if (wcmatch grp "`*")
    (if
      (entmod
(append (entget dic) (list '(3 . "*") (cons 350 gde)))
      );; thanks vk/rjp
       (setq grp
      (cdadr
(member
  (cons 350 gde)
  (reverse (entget dic))
)
      )
       )
    )
    (dictadd dic grp gde)
  )
)
(LM:groupentities grp lst sel)
      )
    )
  )
)
(defun c:test (/ grp idx lst sel)
  (while
    (not
      (or (wcmatch (setq grp (getstring t "Specify group name: "))
   "`*,"
  )
  (snvalid grp)
      )
    )
     (princ "\nGroup name invalid.")
  )
  (if (and (/= "" grp) (setq sel (ssget)))
    (progn
      (repeat (setq idx (sslength sel))
(setq lst (cons (ssname sel (setq idx (1- idx))) lst))
      )
      (LM:groupentities grp lst t)
    )
  )
)

(defun gxl-Sel-SS->AX:Array (ss / c r en)
  (vl-load-com)
  (setq c -1)
  (repeat (sslength ss)
    (setq en (ssname ss (setq c (1+ c))))
    (if (entget en)
      (setq r (cons en r))
    )
  )
  (setq r (reverse r))
  (vlax-safearray-fill
    (vlax-make-safearray
      vlax-vbObject
      (cons 0 (1- (length r)))
    )
    (mapcar 'vlax-ename->vla-object r)
  )
)
;;;Creat Unname Group

(vla-AppendItems
  (vla-add (vla-get-Groups
     (vla-get-activedocument (vlax-get-acad-object))
   )
   "*"
  )
  (gxl-Sel-SS->AX:Array (ssget))
)


(vl-load-com)
(DEFUN c:GGG (/ E EL N SS)
  (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
  (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
  ;;清理空组
  (C:DelEmptyGroup)
  ;;显示当有组数量
  (princ (strcat "\n 当前有 " (itoa (c:GroupsCount)) " 个组"))
  ;;显示所有组名
  (princ (C:AllGroups))

  (_StartUndo *DOC*)
  (SETQ E (CAR (ENTSEL "\n &#38;#32452;[&#38;#21019;&#38;#24314;&#38;#25110;&#38;#22686;&#38;#20943;&#38;#25104;&#38;#21592;/&#38;#20998;&#38;#35299;]<&#38;#20998;&#38;#35299;&#38;#25152;&#38;#26377;&#38;#32452;>")))
  (if e
    (if (_GROUPNAMES e) ;&#38;#26159;&#38;#32452;
      (_GroupAddOrDel e)
      ;;&#38;#36873;&#38;#25321;&#38;#23545;&#38;#35937;&#38;#21019;&#38;#24314;&#38;#32452;
      (if (setq ss (LM:ssget "\n &#38;#36873;&#38;#25321;&#38;#23545;&#38;#35937;&#38;#21019;&#38;#24314;&#38;#26080;&#38;#21517;&#38;#32452;" nil))
(progn
  (ssadd e ss)
  (IF (> (SSLENGTH SS) 1)
    (PROGN
      (repeat (setq n (sslength ss))
(setq eL (cons (ssname ss (setq n (1- n))) eL))
      )
      (_CreateGroup (mapcar 'vlax-ename->vla-object eL))
      (princ "\n &#38;#25104;&#38;#21151;&#38;#21019;&#38;#24314;&#38;#26080;&#38;#21517;&#38;#32452;")
    )
    (princ "\n &#38;#21482;&#38;#26377;&#38;#19968;&#38;#20010;&#38;#23545;&#38;#35937;&#38;#65292;&#38;#19981;&#38;#33021;&#38;#21019;&#38;#24314;&#38;#32452;")
  )
)
(princ "\n &#38;#27809;&#38;#26377;&#38;#36873;&#38;#25321;&#38;#23545;&#38;#35937;&#38;#65292;&#38;#19981;&#38;#33021;&#38;#21019;&#38;#24314;&#38;#32452;")
      )
    )
    ;;&#38;#31354;&#38;#36873;&#38;#26102;, &#38;#20998;&#38;#35299;&#38;#26377;&#38;#30340;&#38;#32452;
    (C:DelAllGroups)
  )
  (_EndUndo *DOC*)

  (gc)
  (princ "\n &#38;#32452;&#38;#25805;&#38;#20316;&#38;#21629;&#38;#20196; GGG")
  (princ)
)
(princ "\n &#38;#32452;&#38;#25805;&#38;#20316;&#38;#21629;&#38;#20196; GGG")

;;1 &#38;#24102;&#38;#25552;&#38;#31034;&#38;#30340;ssget
(defun LM:ssget (msg arg / sel)
  (princ msg)
  (setvar 'nomutt 1)
  (setq sel (vl-catch-all-apply 'ssget arg))
  (setvar 'nomutt 0)
  (if (not (vl-catch-all-error-p sel))
    sel
  )
)
;;2 &#38;#21019;&#38;#24314;&#38;#32452;
(defun _CreateGroup (Objlst)
  (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
  (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
  (vla-appenditems
    (vla-add (vla-get-groups *DOC*) "*")
    (vlax-make-variant
      (vlax-safearray-fill
(vlax-make-safearray
  vlax-vbobject
  (cons 0 (1- (length objlst)))
)
objlst
      )
    )
  )
)
;;3 &#38;#32479;&#38;#35745;&#38;#32452;&#38;#23450;&#38;#20041;&#38;#20010;&#38;#25968;
(defun c:GroupsCount ()
  (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
  (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
  (vla-get-count (vla-get-groups *DOC*))
)

;;4 &#38;#21024;&#38;#38500;&#38;#25152;&#38;#26377;&#38;#32452;&#38;#23450;&#38;#20041;
(defun c:DelAllGroups ()
  (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
  (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
  (vlax-for obj (vla-get-groups *DOC*)
    (vla-delete obj)
  )
)

;;5 &#38;#21024;&#38;#38500;&#38;#31354;&#38;#32452;
(defun c:DelEmptyGroup ()
  (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
  (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
  (vlax-for obj (vla-get-groups *DOC*)
    (if (< (vla-get-count obj) 2)
      (vla-delete obj)
    )
  )
)

;;7 &#38;#27714;&#38;#25152;&#38;#26377;&#38;#32452;&#38;#21517; -> ("*A1" "*A2" "2")
(defun C:AllGroups (/ LST)
  (setq lst (dictsearch (namedobjdict) "ACAD_GROUP"))
  (mapcar 'cdr
  (vl-remove-if '(lambda (x) (/= (car x) 3)) lst)
  )
)
;;8 &#38;#23454;&#38;#20307;&#38;#25152;&#38;#22312;&#38;#32452;&#38;#21517; => ("*A4")
;;(_GROUPNAMES (car(entsel)))
(defun _GROUPNAMES (ENAME / KEY DICT RESULT)
  (setq KEY  (cons 340 ENAME)
DICT (dictsearch (namedobjdict) "acad_group")
  )
  (while (setq DICT (member (assoc 3 DICT) DICT))
    (if (member KEY (entget (cdadr DICT)))
      (setq RESULT (cons (cdar DICT) RESULT))
    )
    (setq DICT (cddr DICT))
  )
  (reverse RESULT)
)

;;9 &#38;#20998;&#38;#35299;&#38;#29305;&#38;#23450;&#38;#32452;&#38;#21517;&#38;#30340;&#38;#32452;
;;(_DelOneGroup "*A4")
(mapcar '_DelOneGroup (_GROUPNAMES (car(entsel))))
(defun _DelOneGroup (N)
  (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
  (or *DOC* (setq *DOC* (vla-get-ActiveDocument *ACAD*)))
  (vlax-for obj (vla-get-groups *DOC*)
    (if (= (vla-get-name obj) N)
      (vla-delete obj)
    )
  )
)
;;;;;&#38;#33719;&#38;#21462;&#38;#32452;&#38;#20869;&#38;#25152;&#38;#26377;&#38;#22270;&#38;#20803;&#38;#21015;&#38;#34920;
(defun _groupent (name / lst EnsLst)
  (or *groups*
      (setq *groups* (vla-get-groups
       (vla-get-activedocument (vlax-get-acad-object))
     )
      )
  )
  (setq EnsLst (vlax-for X (vla-item *groups* name)
(setq lst (cons (vlax-vla-object->ename X) lst))
       )
  )
  EnsLst
)
(SETQ E1 (car(entsel)))
(SETQ E2 (car(entsel)))
(SETQ LST (LIST E1 E2))
(SETQ GROUPNAMELST(LM:ListsUnion(MAPCAR '_GROUPNAMES LST)))
(_groupent  (CAR GROUPNAMELST))
(SETQ  ENTLST   (CAR(mapcar  '_groupent GROUPNAMELST)))
(SETQ I 0)
(REPEAT (LENGTH ENTLST)
  (_DelOneGroup (CAR(_GROUPNAMES (NTH I ENTLST))))
  (SETQ I (1+ I))
)

(FOREACH X ENTLST
  (_DelOneGroup (CAR(_GROUPNAMES X)))
)
(mapcar 'vlax-ename->vla-object ENTLST)
 
(_CreateGroup (mapcar 'vlax-ename->vla-object ENTLST))

;;(LM:ListsUnion '((1 2 3 4 5) (1 3 5 7 9) (2 4 6 8)))
;;;(1 2 3 4 5 7 9 6 8)
(defun LM:ListsUnion ( l )
  ( (lambda ( f ) (f (apply 'append l)))
    (lambda ( l ) (if l (cons (car l) (f (vl-remove (car l) (cdr l))))))
  )
)


;;;;;;(LY:CreateGroup (LIST E1 E2))
(DEFUN LY:CreateGroup (LST   )
  (SETQ LST (CAR (mapcar '_groupent  (LM:ListsUnion(MAPCAR '_GROUPNAMES LST)))))
  (FOREACH X LST
    (_DelOneGroup (CAR (_GROUPNAMES X)))
  )
  (_CreateGroup (mapcar 'vlax-ename->vla-object LST))
)



 
 
(vl-load-com) 
(defun c:Example_CopyObjects() 
    ;; This example creates a Circle object and uses the CopyObjects 
    ;; method to make a copy of the new Circle. 
    (setq acadObj (vlax-get-acad-object)) 
    (setq doc (vla-get-ActiveDocument acadObj)) 
 
    ;; Load the ObjectDBX library 
    (if (= acLibImport nil) 
    (progn 
        (vlax-import-type-library :tlb-filename "C:\\Program Files\\Common Files\\Autodesk Shared\\axdb19enu.tlb" 
                                  :methods-prefix "acdbm-" 
                                  :properties-prefix "acdbp-" 
                                  :constants-prefix "acdbc-" 
        ) 
            (setq acLibImport T) 
        ) 
    ) 
 
    ;; Create a reference to the ObjectDBX object 
    (setq acdbObj (vlax-create-object "ObjectDBX.AxDbDocument.19")) 
 
    ;; Open an external drawing file 
    (acdbm-open acdbObj (findfile ".\\Sample\\VBA\\Tower.dwg")) 
 
    ;; Add two circles to the drawing 
    (setq objCollection (vlax-make-safearray vlax-vbObject (cons 0 (- (vla-get-Count (vla-get-ModelSpace acdbObj)) 1))) 
      count 0) 
 
    ;; Copy objects 
    (vlax-for eachObj (vla-get-ModelSpace acdbObj) 
        (vlax-safearray-put-element objCollection count eachObj) 
        (setq count (1+ count)) 
    ) 
       
    ;; Copy object and get back a collection of the new objects (copies) 
    (setq retObjects (vla-CopyObjects acdbObj objCollection (vla-get-ModelSpace (vla-get-Database doc)))) 
       
    (vla-ZoomAll acadObj) 
       
    (alert "Model space objects copied.") 
 
    ;; Close the in memory drawing 
    (vlax-release-object acdbObj) 
) 



[martinle]

Hello liuhe, thanks for your help. Unfortunately I didn't learn Lisp. Try to take small steps to understand Lisp. Unfortunately I can't get your code to work.

[danAllen]

Your idea sounds good, I would need to test to confirm. I wonder why your workflow needs this to be done repeatedly and thus needs a lisp program for repeated use. If you have the same content in multiple drawings I would either create a separate file to be xreffed or inserted as a block into other drawings.

[tombu]

As references for dimension overrides and groups are to the drawing they're created in directly inserting a drawing or objects from another drawing results in losing all of them.
I've always used a macro for pasting objects as a group in a new drawing by pasting as a block, exploding it, creating a group from the exploded objects, then purging the block.
https://cadtips.cadalyst.com/import/paste-objects-group

Code: [Select]

^C^C_pasteblock;(setq LstBlk(vla-get-Name (vlax-ename->vla-object (entlast))));_explode;_last;_
-group;_create;*;;_previous;;(command "-purge" "B" LstBlk "N")(setq LstBlk nil)

[martinle]

Hello Tombu, thanks for your support. Yes, I know this version. Only if I have a lot of groups that I have to insert into another drawing is this solution very tedious. I want something that grabs all the groups in the drawing, changes them to blocks, and then inserts a new drawing into them, and then converts those blocks back into groups. This solution would be very helpful for me
Martin