entget from another DWG without activating it

[Ahankhah]

Hi everyone,

I wrote an AutoLISP program that extracts a DWG’s contents into the current drawing without opening the file. Since VLA_OBJECTs are limited, I used entget, but AutoCAD crashes with a Fatal Error.

Does anyone know what might be wrong or which part of the code I should fix?
 

(defun MT:GetFileD (title lastPath defaultfile ext flag /)
 (or (= 'STR (type defaultfile)) (setq defaultfile ""))
 (if (= 'STR (type lastPath))
  (setq defaultfile (strcat lastPath "\\" defaultfile))
 )
 (getfiled title defaultfile ext flag)
)

(defun MT:GetEntgetListFromDwg (dwgfilename / doc ss entgetlist)
 (if (setq dwgfilename (findfile dwgfilename))
  (progn
   (setq doc (vla-open (vla-get-Documents (vlax-get-acad-object)) dwgfilename :vlax-false))
   (setq entgetlist '())
   (setq ss (vla-get-ModelSpace doc))
   (vlax-for obj ss
    (setq entgetlist (cons (entget (vlax-vla-object->ename obj)) entgetlist))
   )
   (vlax-release-object ss)
   (setq ss nil)
   (vla-close doc)
   (vlax-release-object doc)
  )
 )
 entgetlist
)

(defun MT:RefineEntgetList (entgetlist / item)
 (foreach item entgetlist
  (setq newitem (vl-remove (assoc -1 item) item))
  (setq newitem (vl-remove (assoc 330 item) newitem))
  (setq newitem (vl-remove (assoc 5 item) newitem))
  (setq entgetlist (subst newitem item entgetlist))
 )
 entgetlist
)

;;;(c:CompareDwgs)
(defun c:CompareDwgs (/ regKey lastPath mainfile revisedfile entlist-main entlist-revised entlist-first entlist-second
                      entlist-both ss ent
                     )
 ;; registry key to store last path
 (setq regKey "HKEY_CURRENT_USER\\Software\\Ahankhah\\CompareDwgs")
 (setq lastPath (vl-registry-read regKey "LastPath"))
 ;; ask user for first file
 (setq mainfile (MT:GetFileD "Select main drawing" lastPath "main.dwg" "dwg" 0))
 ;; if user cancelled, exit gracefully
 (if (not mainfile)
  (progn (princ "\nOperation canceled by user.") (princ))
  ;; else proceed to ask for second file
  (progn
   (setq lastPath (vl-filename-directory mainfile))
   (vl-registry-write regKey "LastPath" lastPath)
   ;; use folder of first file as default for second
   (setq revisedfile (MT:GetFileD "Select revised drawing" lastPath "revised.dwg" "dwg" 0))
   ;; if user cancelled selecting second file, exit gracefully
   (if (not revisedfile)
    (progn (princ "\nOperation canceled by user.") (princ))
    ;; else we have both files — save last path (folder of second) and continue
    (progn
     (setq lastPath (vl-filename-directory revisedfile))
     (vl-registry-write regKey "LastPath" lastPath)
     (setq entlist-main (MT:GetEntgetListFromDwg mainfile))
     (setq entlist-revised (MT:GetEntgetListFromDwg revisedfile))
     (setq entlist-first (MT:RefineEntgetList entlist-main))
     (setq entlist-second (MT:RefineEntgetList entlist-revised))
     (setq entlist-both '())
     (foreach elist entlist-first
      (if (member elist entlist-second)
       (progn
        (setq entlist-first (vl-remove elist entlist-first))
        (setq entlist-second (vl-remove elist entlist-second))
        (setq entlist-both (cons elist entlist-both))
       )
      )
     )
     (princ "\nComparison done. Lists are ready.")
     (foreach elist entlist-both (entmakex elist))
     (foreach elist entlist-first
      (if (assoc 62 elist)
       (setq elist (subst (cons 62 1) (assoc 62 elist) elist))
       (setq elist (append elist (list (cons 62 1))))
      )
      (entmakex elist)
     )
     (foreach elist entlist-second
      (if (assoc 62 elist)
       (setq elist (subst (cons 62 2) (assoc 62 elist) elist))
       (setq elist (append elist (list (cons 62 2))))
      )
      (entmakex elist)
     )
     (princ)
    )                                             ; end else have revisedfile
   )                                              ; end if revisedfile
  )                                               ; end else have mainfile
 )                                                ; end if mainfile
)

 

[mhupp]

 

3 hours ago, Ahankhah said:

Does anyone know what might be wrong or which part of the code I should fix

 

Haven't looked at the code but FYI.

 

Entity names are generated when the drawing is open making them unique and random and only  valid for that drawing. You can't save an entity name's and call it later when a drawing is closed or use entget with that entity name from another drawing.

 

-edit

So a circle in two drawings with everything the same layer, color, xyz location will have two different entity names.

 

<Entity name: 1A3F5B7C>
<Entity name: 2B8E4D9A>

 

Edited 2 hours ago by mhupp

[mhupp]

What I did when having to compare warehouse layouts is saving them out as old and new flatting everything and change the old to light gray and the new to blue. inserting them as xref.

[rlx]

not sure what you want to accomplish with this?

 

would a simple insert not do the same. You could retrieve all objects after explode :

 

 

 

Your code won't work this way but nice try.

 

If you want to copy object between drawings it would work something like this :

 

;;; copy selectionset to drawing
(defun ctd ( ss dwg / ss->ol dbx_ver acApp acDoc dbx object-list object-safe-array)  
  (defun SS->OL (ss / i l)
    (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l)
  (defun dbx_ver ( / v)
    (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))
  (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp))
  (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver))))
  (vla-open dbx dwg)
  ; put all objects from SS in a list
  (foreach object (ss->ol ss) (setq object-list (cons object object-list)))
  ; put list with objects in a safe array
  (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list)))))
  (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list))
  ; copy objects to dbx-drawing
  (vla-CopyObjects acDoc object-safe-array (vla-get-ModelSpace dbx))
  (vl-catch-all-apply 'vla-saveas (list dbx dwg))
  (vl-catch-all-apply 'vlax-release-object (list dbx))
  (setq object-list nil object-safe-array nil)
  (princ)
)

(defun c:t1 ( / ss d)
  (if (and (setq ss (ssget)) (setq d (getfiled "Copy SS to:" "" "dwg" 0)))
    (ctd ss d)
  )
  (princ)
)

 

the other way around (very little error trapping , like selected drawing must be closed) :

 

;;; copy from (dbx) drawing (all objects / all layouts)
(defun cfd ( / acApp acDoc dbx dwg object-list object-safe-array)
  (defun SS->OL (ss / i l)
    (setq i 0)(repeat (sslength ss)(setq l (cons (vlax-ename->vla-object (ssname ss i)) l) i (1+ i))) l)
  (defun dbx_ver ( / v)
    (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))
  (setq acApp (vlax-get-acad-object) acDoc (vla-get-ActiveDocument acApp))
  (setq dbx (vl-catch-all-apply 'vla-getinterfaceobject (list acApp (dbx_ver))))
  (setq dwg (getfiled "Copy (all) objects from :" "" "dwg" 0))
  (vla-open dbx dwg)
  (vlax-for block (vla-get-blocks dbx)
    (vlax-for object block
      (setq object-list (cons object object-list))
    )
  )
  ; put list with objects in a safe array
  (setq object-safe-array (vlax-make-safearray vlax-vbobject (cons 0 (1- (length object-list)))))
  (vl-catch-all-apply 'vlax-safearray-fill (list object-safe-array object-list))
  ; copy objects from dbx-drawing to active drawing
  (vla-CopyObjects dbx object-safe-array (vla-get-ModelSpace acDoc))
  (vl-catch-all-apply 'vlax-release-object (list dbx))
  (princ)
)

 

Probably master Lee also has some routines on his web site to copy between drawings

Latest AutoCad versions have a compare drawing command?

 

 

Edited 47 minutes ago by rlx