Topic: run a lisp in dwgs WITHOUT opening the dwgs?

[Amsterdammed]

Hello,

I just ran the “Layer filter delete.lsp” from the post down here on this page and saw a dwg with the size of 2 MB limited to 400KB. So that is great.

 Now I wonder:

We gave a lot of dwgs on our server, a lot of 3rd party dwgs with 20000+ layer filters, too.

Is there a way to approach the dwgs and run the “layer filter delete” WITHOUT opening the dwgs? (I know how to do it in a script with opening one for one).

Thanks in advance,

Bernd

[Keith™]

you might be able to do it using ObjectDBX by importing the type libraries into vlisp

[whdjr]

Here is one I put together for AutoCad 2000:

Code: [Select]

(defun LayerFiltersDelete (doc)
  (vl-Catch-All-Apply
    '(lambda ()
       (vla-Remove
(vla-GetExtensionDictionary
   (vla-Get-Layers doc)
)
"ACAD_LAYERFILTERS"
       )
     )
  )
)

(defun w:*error* (msg)
  (princ "\nError: ")
  (princ msg)
  (princ)
  (if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
    (vlax-release-object dbxdoc)
  )
  (gc)
  (princ)
)

(defun get_dwgs (path)
  (mapcar '(lambda (x)
     (mapcar '(lambda (y)
(strcat x "\\" y)
      )
     (vl-directory-files x "*.dwg" 1)
     )
   )
  path
  )
)

(defun c:lfd_odbx (/ kword folder file files dbxdoc of *error*)
  (initget 1 "Yes No")
  (setq kword (getkword
  "Do you want to search in subdirectories? [Yes/No]: "
)
files (cond ((eq kword "Yes")
       (apply 'append
      (get_dwgs (*list_folders* (acet-ui-pickdir)))
       )
      )
      ((eq kword "No")
       (setq file (getfiled "Select a File" "" "dwg" (+ 4 128)))
       (car (get_dwgs (list (vl-filename-directory file))))
      )
)
*error* w:*error*
  )
  (if (not (*DBX-Register*))
    (*error* "Could not load the ObjectDBX Interface.")
  )
  (setq dbxdoc (vla-GetInterfaceObject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument"
       )
  )
  (foreach f files
    (setq of (vl-catch-all-apply
       '(lambda ()
  (vlax-invoke-method dbxdoc 'open f)
)
     )
    )
    (if (vl-catch-all-error-p of)
      (*error* (vl-catch-all-error-message of))
      (progn
(LayerFiltersDelete dbxdoc)
(princ
  (strcat "\nDeleting Layer Filters in " f)
)
(vla-saveas dbxdoc f)
      )
    )
  )
  (vlax-release-object dbxdoc)
  (gc)
  (princ)
)



[Amsterdammed]

Will,
I miss something in your code:

; error: no function definition: *LIST_FOLDERS*

Bernd

[whdjr]

oops...sorry 

Your actually missing some more too.
Just use this instead of what I posted earlier:

;;;
;;;Utilities to register ObjectDBX with AutoCAD 2K
;;;
(defun *DLLRegister* (dll)
  (startapp "regsvr32.exe" (strcat "/s \"" dll "\""))
)

(defun *ProgID->ClassID* (ProgID)
  (vl-registry-read
    (strcat "HKEY_CLASSES_ROOT\\" progid "\\CLSID")
  )
)

(defun *DBX-Register* (/ classname server)
  (setq classname "ObjectDBX.AxDbDocument")
  (cond
    ((*ProgID->ClassID* classname))
    ((and
       (setq server (findfile "AxDb15.dll"))
       (*DLLRegister* server)
       (*ProgID->ClassID* classname)
     )
     (*ProgID->ClassID* classname)
    )
    ((not (setq server (findfile "AxDb15.dll")))
     (alert
       "Error: Cannot locate ObjectDBX Type Library (AxDb15.dll)..."
     )
    )
    (T
     (*DLLRegister* classname)
     (or
       (*ProgID->ClassID* classname)
       (alert
    "Error: Failed to register ObjectDBX ActiveX services..."
       )
     )
    )
  )
)
;;;
;;;
;;;
(defun *layout_list* (/ lst)
  (vlax-map-collection
    (vla-get-layouts
      (vla-get-activedocument (vlax-get-acad-object))
    )
    '(lambda (x) (setq lst (cons x lst)))
  )
  (cdr
    (*sort* lst 'vla-get-taborder)
  )
)


(defun *sort* (lst func)
  (vl-sort lst
      '(lambda (e1 e2)
         (< ((eval func) e1) ((eval func) e2))
       )
  )
)

(defun LayerFiltersDelete (doc)
  (vl-Catch-All-Apply
    '(lambda ()
       (vla-Remove
    (vla-GetExtensionDictionary
      (vla-Get-Layers doc)
    )
    "ACAD_LAYERFILTERS"
       )
     )
  )
)

(defun w:*error* (msg)
  (princ "\nError: ")
  (princ msg)
  (princ)
  (if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
    (vlax-release-object dbxdoc)
  )
  (gc)
  (princ)
)

(defun get_dwgs   (path)
  (mapcar '(lambda (x)
        (mapcar '(lambda (y)
         (strcat x "\\" y)
            )
           (vl-directory-files x "*.dwg" 1)
        )
      )
     path
  )
)

(defun c:lfd_odbx (/ kword folder file files dbxdoc of *error*)
  (initget 1 "Yes No")
  (setq   kword   (getkword
        "Do you want to search in subdirectories? [Yes/No]: "
      )
   files   (cond ((eq kword "Yes")
             (apply 'append
               (get_dwgs (*list_folders* (acet-ui-pickdir)))
             )
            )
            ((eq kword "No")
             (setq file (getfiled "Select a File" "" "dwg" (+ 4 128)))
             (car (get_dwgs (list (vl-filename-directory file))))
            )
      )
   *error*   w:*error*
  )
  (if (not (*DBX-Register*))
    (*error* "Could not load the ObjectDBX Interface.")
  )
  (setq   dbxdoc (vla-GetInterfaceObject
       (vlax-get-acad-object)
       "ObjectDBX.AxDbDocument"
          )
  )
  (foreach f files
    (setq of (vl-catch-all-apply
          '(lambda   ()
        (vlax-invoke-method dbxdoc 'open f)
      )
        )
    )
    (if   (vl-catch-all-error-p of)
      (*error* (vl-catch-all-error-message of))
      (progn
   (LayerFiltersDelete dbxdoc)
   (princ
     (strcat "\nDeleting Layer Filters in " f)
   )
   (vla-saveas dbxdoc f)
      )
    )
  )
  (vlax-release-object dbxdoc)
  (gc)
  (princ)
)

[Amsterdammed]

Will,

indeed there were more missing.

But........... Sitll missing the *LIST_FOLDERS* function

Bernd

[ronjonp]

I get the same error as well Will.

When in doubt....search the forum .

http://www.theswamp.org/forum/index.php?topic=3564.msg43226#msg43226

[MP]

Hello,

I just ran the “Layer filter delete.lsp” from the post down here on this page and saw a dwg with the size of 2 MB limited to 400KB. So that is great.

Now I wonder:

We gave a lot of dwgs on our server, a lot of 3rd party dwgs with 20000+ layer filters, too.

Is there a way to approach the dwgs and run the “layer filter delete” WITHOUT opening the dwgs? (I know how to do it in a script with opening one for one).

Thanks in advance,

Bernd

Please be careful Amsterdammed, I've seen attempts at automatic fixes become automatic fubars. Backup your data, do exhaustive tests on representative sample data, have a recovery plan. You don't want to be the latest entry in this thread.

[ronjonp]

Will,

So what the next step in troubleshooting when I get the error:

Error: Failed to register ObjectDBX ActiveX services...
Error: Could not load the ObjectDBX Interface.
Error: Automation Error. Problem in loading application

I changed the AxDb15.dll to AxDb16.dll since I'm on 2005.

So I did some searching in the registry and found that "ObjectDBX.AxDbDocument" is "ObjectDBX.AxDbDocument.16". Changed that but still getting the error:

Error: Automation Error. Problem in loading application


Thanks,

Ron

[Amsterdammed]

Right Micheael,

It still always scares me when a  lot of things are  done automatically. But we have everything on tape  as back up, and I sure will not let a lisp run all over the server to change  all the dwgs. But I will definitely use it for cleaning up 3rd party dwgs we use as xrefs.
But thanks for the reminder Michael, indeed I don’t want to join the “wound liking dogs” club.

Bernd

[whdjr]

Sorry for the confusion guys:

This should work for 2000 and 2002:

Code: [Select]

;;;
;;;Utilities to register ObjectDBX with AutoCAD 2K
;;;
(defun *DLLRegister* (dll)
  (startapp "regsvr32.exe" (strcat "/s \"" dll "\""))
)

(defun *ProgID->ClassID* (ProgID)
  (vl-registry-read
    (strcat "HKEY_CLASSES_ROOT\\" progid "\\CLSID")
  )
)

(defun *DBX-Register* (/ classname server)
  (setq classname "ObjectDBX.AxDbDocument")
  (cond
    ((*ProgID->ClassID* classname))
    ((and
       (setq server (findfile "AxDb15.dll"))
       (*DLLRegister* server)
       (*ProgID->ClassID* classname)
     )
     (*ProgID->ClassID* classname)
    )
    ((not (setq server (findfile "AxDb15.dll")))
     (alert
       "Error: Cannot locate ObjectDBX Type Library (AxDb15.dll)..."
     )
    )
    (T
     (*DLLRegister* classname)
     (or
       (*ProgID->ClassID* classname)
       (alert
"Error: Failed to register ObjectDBX ActiveX services..."
       )
     )
    )
  )
)
;;;
;;;
;;;
(defun *layout_list* (/ lst)
  (vlax-map-collection
    (vla-get-layouts
      (vla-get-activedocument (vlax-get-acad-object))
    )
    '(lambda (x) (setq lst (cons x lst)))
  )
  (cdr
    (*sort* lst 'vla-get-taborder)
  )
)


(defun *sort* (lst func)
  (vl-sort lst
   '(lambda (e1 e2)
      (< ((eval func) e1) ((eval func) e2))
    )
  )
)

(defun *list_folders* (path)
  (defun get_folders (folder / f)
    (mapcar '(lambda (x)
       (cons (setq f (strcat folder "\\" x))
     (apply 'append (get_folders f))
       )
     )
    (cddr (vl-directory-files folder nil -1))
    )
  )
  (cons path (apply 'append (get_folders path)))
)

(defun LayerFiltersDelete (doc)
  (vl-Catch-All-Apply
    '(lambda ()
       (vla-Remove
(vla-GetExtensionDictionary
   (vla-Get-Layers doc)
)
"AcLyDictionary"
       )
     )
  )
)

(defun w:*error* (msg)
  (princ "\nError: ")
  (princ msg)
  (princ)
  (if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
    (vlax-release-object dbxdoc)
  )
  (gc)
  (princ)
)

(defun get_dwgs (path)
  (mapcar '(lambda (x)
     (mapcar '(lambda (y)
(strcat x "\\" y)
      )
     (vl-directory-files x "*.dwg" 1)
     )
   )
  path
  )
)

(defun c:lfd_odbx (/ kword folder file files dbxdoc of *error* lst)
  (initget 1 "Yes No")
  (setq kword (getkword
  "Do you want to search in subdirectories? [Yes/No]: "
)
files (cond ((eq kword "Yes")
       (apply 'append
      (get_dwgs (*list_folders* (acet-ui-pickdir)))
       )
      )
      ((eq kword "No")
       (setq file (getfiled "Select a File" "" "dwg" (+ 4 128)))
       (car (get_dwgs (list (vl-filename-directory file))))
      )
)
*error* w:*error*
  )
  (if (not (*DBX-Register*))
    (*error* "Could not load the ObjectDBX Interface.")
  )
  (setq dbxdoc (vla-GetInterfaceObject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument"
       )
  )
  (foreach f files
    (setq of (vl-catch-all-apply
       '(lambda ()
  (vlax-invoke-method dbxdoc 'open f)
)
     )
    )
    (if (vl-catch-all-error-p of)
      (setq lst (cons (vl-catch-all-error-message of) lst))
      (progn
(LayerFiltersDelete dbxdoc)
(princ
  (strcat "\nDeleting Layer Filters in " f)
)
(vla-saveas dbxdoc f)
      )
    )
  )
  (vlax-release-object dbxdoc)
  (gc)
  (if lst (princ lst))
  (princ)
)

This should work for 2004:

Code: [Select]

(defun *layout_list* (/ lst)
  (vlax-map-collection
    (vla-get-layouts
      (vla-get-activedocument (vlax-get-acad-object))
    )
    '(lambda (x) (setq lst (cons x lst)))
  )
  (cdr
    (*sort* lst 'vla-get-taborder)
  )
)
;;;
(defun *sort* (lst func)
  (vl-sort lst
   '(lambda (e1 e2)
      (< ((eval func) e1) ((eval func) e2))
    )
  )
)
;;;
(defun *list_folders* (path)
  (defun get_folders (folder / f)
    (mapcar '(lambda (x)
       (cons (setq f (strcat folder "\\" x))
     (apply 'append (get_folders f))
       )
     )
    (cddr (vl-directory-files folder nil -1))
    )
  )
  (cons path (apply 'append (get_folders path)))
)
;;;
(defun LayerFiltersDelete (doc)
  (vl-Catch-All-Apply
    '(lambda ()
       (vla-Remove
(vla-GetExtensionDictionary
   (vla-Get-Layers doc)
)
"AcLyDictionary"
       )
     )
  )
)
;;;
(defun w:*error* (msg)
  (princ "\nError: ")
  (princ msg)
  (princ)
  (if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
    (vlax-release-object dbxdoc)
  )
  (gc)
  (princ)
)
;;;
(defun get_dwgs (path)
  (mapcar '(lambda (x)
     (mapcar '(lambda (y)
(strcat x "\\" y)
      )
     (vl-directory-files x "*.dwg" 1)
     )
   )
  path
  )
)
;;;
(defun c:lfd_odbx (/ kword folder file files dbxdoc of *error* lst)
  (initget 1 "Yes No")
  (setq kword (getkword
  "Do you want to search in subdirectories? [Yes/No]: "
)
files (cond ((eq kword "Yes")
       (apply 'append
      (get_dwgs (*list_folders* (acet-ui-pickdir)))
       )
      )
      ((eq kword "No")
       (setq file (getfiled "Select a File" "" "dwg" (+ 4 128)))
       (car (get_dwgs (list (vl-filename-directory file))))
      )
)
*error* w:*error*
  )
  (setq dbxdoc (vla-GetInterfaceObject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument.15"
       )
  )
  (foreach f files
    (setq of (vl-catch-all-apply
       '(lambda ()
  (vlax-invoke-method dbxdoc 'open f)
)
     )
    )
    (if (vl-catch-all-error-p of)
      (setq lst (cons (vl-catch-all-error-message of) lst))
      (progn
(LayerFiltersDelete dbxdoc)
(princ
  (strcat "\nDeleting Layer Filters in " f)
)
(vla-saveas dbxdoc f)
      )
    )
  )
  (vlax-release-object dbxdoc)
  (gc)
  (if lst (princ lst))
  (princ)
)


This should work 2005 and 2006:

Code: [Select]

(defun *layout_list* (/ lst)
  (vlax-map-collection
    (vla-get-layouts
      (vla-get-activedocument (vlax-get-acad-object))
    )
    '(lambda (x) (setq lst (cons x lst)))
  )
  (cdr
    (*sort* lst 'vla-get-taborder)
  )
)
;;;
(defun *sort* (lst func)
  (vl-sort lst
   '(lambda (e1 e2)
      (< ((eval func) e1) ((eval func) e2))
    )
  )
)
;;;
(defun *list_folders* (path)
  (defun get_folders (folder / f)
    (mapcar '(lambda (x)
       (cons (setq f (strcat folder "\\" x))
     (apply 'append (get_folders f))
       )
     )
    (cddr (vl-directory-files folder nil -1))
    )
  )
  (cons path (apply 'append (get_folders path)))
)
;;;
(defun LayerFiltersDelete (doc)
  (vl-Catch-All-Apply
    '(lambda ()
       (vla-Remove
(vla-GetExtensionDictionary
   (vla-Get-Layers doc)
)
"ACAD_LAYERFILTERS"
       )
     )
  )
)
;;;
(defun w:*error* (msg)
  (princ "\nError: ")
  (princ msg)
  (princ)
  (if (and dbxdoc (not (vlax-object-released-p dbxdoc)))
    (vlax-release-object dbxdoc)
  )
  (gc)
  (princ)
)
;;;
(defun get_dwgs (path)
  (mapcar '(lambda (x)
     (mapcar '(lambda (y)
(strcat x "\\" y)
      )
     (vl-directory-files x "*.dwg" 1)
     )
   )
  path
  )
)
;;;
(defun c:lfd_odbx (/ kword folder file files dbxdoc of *error* lst)
  (initget 1 "Yes No")
  (setq kword (getkword
  "Do you want to search in subdirectories? [Yes/No]: "
)
files (cond ((eq kword "Yes")
       (apply 'append
      (get_dwgs (*list_folders* (acet-ui-pickdir)))
       )
      )
      ((eq kword "No")
       (setq file (getfiled "Select a File" "" "dwg" (+ 4 128)))
       (car (get_dwgs (list (vl-filename-directory file))))
      )
)
*error* w:*error*
  )
  (setq dbxdoc (vla-GetInterfaceObject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument.16"
       )
  )
  (foreach f files
    (setq of (vl-catch-all-apply
       '(lambda ()
  (vlax-invoke-method dbxdoc 'open f)
)
     )
    )
    (if (vl-catch-all-error-p of)
      (setq lst (cons (vl-catch-all-error-message of) lst))
      (progn
(LayerFiltersDelete dbxdoc)
(princ
  (strcat "\nDeleting Layer Filters in " f)
)
(vla-saveas dbxdoc f)
      )
    )
  )
  (vlax-release-object dbxdoc)
  (gc)
  (if lst (princ lst))
  (princ)
)


edit:  Added functionality to print a list of drawings that were not changed.

[ronjonp]

Thanks will .

One more question....how would one go about modifying this so it ignores readonly files rather than crashing the proggie?

[Jeff_M]

Note that the use of ObjectDBX and saving the drawing loses the Drawing preview image. If you wish to maintain the image, see THIS post that uses a helper app. If you need help implementing it just let me know.

ronjonp, you will need to wrap the Saveas line into a vl-catch-all-apply function. I would suggest placing the name of any file that cannot be saved into a text file so you know which ones were not modified.

[whdjr]

Thanks will .

One more question....how would one go about modifying this so it ignores readonly files rather than crashing the proggie?

I'll have to check into that.  I came across that before but I don't remember what I did to resolve it.

[whdjr]

...ronjonp, you will need to wrap the Saveas line into a vl-catch-all-apply function. I would suggest placing the name of any file that cannot be saved into a text file so you know which ones were not modified.

I think it is already done that way Jeff.

Code: [Select]

(setq of (vl-catch-all-apply
       '(lambda ()
             (vlax-invoke-method dbxdoc 'open f)
        )
     )
)