- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Dear forum members,
I want an lisp that would be able to open a dwg in the background and do some stuff with it
Now I use the code made by Lee Mac but that one does not allow the following
;; - No SelectionSets (ssget, ssname, ssdel, etc) ;;
;; - No Command Calls (command "_.line" ... etc) ;;
;; - No ent* methods (entget, entmod, entupd, etc) ;;
;; - No Access to System Variables (setvar, getvar, setvariable, etc)
Does anyone knows how to open an dwg in the background and then read out the title block? ( attributes)
I already have a lisp that does this but the screen is refreshing whole time ( because of opening and closing the dwg )
If possible I would like to do this in the background
See sample code below
This code will open dwg in background change layer color and saves the dwg
Tested it and works perfect
Now what I want is this,
Open in the background an dwg and select title block / read out the att's and write to specific file
Kind regards,
;;-----------------------=={ ObjectDBX Wrapper }==----------------------;;
;; ;;
;; Evaluates a supplied function on all drawings in a given list or ;;
;; selected directory. ;;
;;----------------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
;; Arguments: ;;
;; ;;
;; fun [SYM] ;;
;; --------------------------------- ;;
;; A function requiring a single argument (the VLA Document object), ;;
;; and following the 'rules' of ObjectDBX: ;;
;; ;;
;; - No SelectionSets (ssget, ssname, ssdel, etc) ;;
;; - No Command Calls (command "_.line" ... etc) ;;
;; - No ent* methods (entget, entmod, entupd, etc) ;;
;; - No Access to System Variables (setvar, getvar, setvariable, etc) ;;
;; ;;
;; lst [LIST] [Optional] ;;
;; --------------------------------- ;;
;; List of DWG Filenames; if nil, BrowseForFolder Dialog is displayed. ;;
;; ;;
;; sav [SYM] ;;
;; --------------------------------- ;;
;; Boolean flag determining whether drawings should be saved following ;;
;; function evaluation (T=saved, nil=not saved). ;;
;;----------------------------------------------------------------------;;
;; Returns: ;;
;; ;;
;; List of: ;;
;; ( ;;
;; (<Drawing Filename> . <Function Result>) ;;
;; (<Drawing Filename> . <Function Result>) ;;
;; ... ;;
;; (<Drawing Filename> . <Function Result>) ;;
;; ) ;;
;; ;;
;; Where: ;;
;; <Drawing Filename> ;;
;; is the filename of drawing that has been processed. ;;
;; ;;
;; <Function Result> ;;
;; is the result of evaluating the supplied function on the Document ;;
;; Object representing the associated drawing filename. ;;
;; ;;
;; If an error occurs when evaluating the supplied function the ;;
;; Function Result will be nil and the error message will be printed ;;
;; to the command-line. ;;
;;----------------------------------------------------------------------;;
(defun LM:ODBX ( fun lst sav / *error* app dbx dir doc dwl err rtn vrs )
(defun *error* ( msg )
(if (and (= 'vla-object (type dbx)) (not (vlax-object-released-p dbx)))
(vlax-release-object dbx)
)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)
(cond
( (not
(or lst
(and (setq dir (LM:browseforfolder "Select Folder of Drawings to Process" nil 512))
(setq lst (mapcar '(lambda ( x ) (strcat dir "\\" x)) (vl-directory-files dir "*.dwg" 1)))
)
)
)
nil
)
( (progn
(setq dbx
(vl-catch-all-apply 'vla-getinterfaceobject
(list (setq app (vlax-get-acad-object))
(if (< (setq vrs (atoi (getvar 'acadver))) 16)
"objectdbx.axdbdocument" (strcat "objectdbx.axdbdocument." (itoa vrs))
)
)
)
)
(or (null dbx) (vl-catch-all-error-p dbx))
)
(prompt "\nUnable to interface with ObjectDBX.")
)
( t
(vlax-for doc (vla-get-documents app)
(setq dwl (cons (cons (strcase (vla-get-fullname doc)) doc) dwl))
)
(foreach dwg lst
(if (or (setq doc (cdr (assoc (strcase dwg) dwl)))
(and (not (vl-catch-all-error-p (vl-catch-all-apply 'vla-open (list dbx dwg))))
(setq doc dbx)
)
)
(progn
(setq rtn
(cons
(cons dwg
(if (vl-catch-all-error-p (setq err (vl-catch-all-apply fun (list doc))))
(prompt (strcat "\n" dwg "\t" (vl-catch-all-error-message err)))
err
)
)
rtn
)
)
(if sava (vla-saveas doc dwg))
)
(princ (strcat "\nError opening file: " (vl-filename-base dwg) ".dwg"))
)
)
(if (= 'vla-object (type dbx))
(vlax-release-object dbx)
)
(reverse rtn)
)
)
)
;;------------------=={ Browse for Folder }==-----------------;;
;; ;;
;; Displays a dialog prompting the user to select a folder. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2013 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; msg - message to display at top of dialog ;;
;; dir - root directory (or nil) ;;
;; flg - bit-coded flag specifying dialog display settings ;;
;;------------------------------------------------------------;;
;; Returns: Selected folder filepath, else nil. ;;
;;------------------------------------------------------------;;
(defun LM:browseforfolder ( msg dir flg / err fld pth shl slf )
(setq err
(vl-catch-all-apply
(function
(lambda ( / app hwd )
(if (setq app (vlax-get-acad-object)
shl (vla-getinterfaceobject app "shell.application")
hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg flg dir)
)
(setq slf (vlax-get-property fld 'self)
pth (vlax-get-property slf 'path)
pth (vl-string-right-trim "\\" (vl-string-translate "/" "\\" pth))
)
)
)
)
)
)
(if slf (vlax-release-object slf))
(if fld (vlax-release-object fld))
(if shl (vlax-release-object shl))
(if (vl-catch-all-error-p err)
(prompt (vl-catch-all-error-message err))
pth
)
)
(vl-load-com) (princ)
(defun c:test ( / lyrName lyrColor)
;write the file
(setq fn (strcat DRSlijst "output.csv")
fp (open fn "w")
)
;(princ "\n" fp)
(write-line (strcat "datum" dlm "filenaam" dlm "formaat" dlm "rev" dlm "statusO" dlm "statusT" dlm "titel" dlm "dwgprefix") fp)
(close fp)
;-----------
(setq PID (GetAllFiles (vl-string-right-trim "\\" PID1) 1 "*.dwg"))
(setq numFiles (length PID))
(setq ORTHO (GetAllFiles (vl-string-right-trim "\\" ORTHOS1) 1 "*.dwg"))
;(setq ORTHO (GrabAllFiles "P:\\Acad\\P3D\\project templates\\Empty Metric Project\\Orthos\\DWGs" ".dwg"))
(setq ORTHO (vl-remove (strcat ORTHOS1 "Orthographic View Selection 1.dwg") ORTHO))
(setq numFiles (+ numFiles (length ORTHO)))
(setq ISO (GetAllFiles (vl-string-right-trim "\\" ISO1) 1 "*.dwg"))
;(setq ISO (GrabAllFiles "P:\\Acad\\P3D\\project templates\\Empty Metric Project\\Isometric\\TEBULO_A1 ENG\\ProdIsos" ".dwg"))
(setq ISO (vl-remove (strcat ISO1 "IsoSymbolStyles.dwg") ISO))
(setq ISO (vl-remove (strcat ISO1 "Plant3dIsoSymbols.dwg") ISO))
(setq numFiles (+ numFiles (length ISO)))
(setq all (append PID ORTHO ISO))
;(setq msg (strcat "Going to Process " (itoa numFiles) " file(s)"))
(setq lyrName (strcase "Pipe") ; your layer name
lyrColor acRed) ; your color
(foreach x
(LM:ODBX
(function
(lambda ( x / lyr )
(vlax-for lyr (vla-get-layers x)
(if (= (strcase (vla-get-name lyr)) lyrName)
(vla-put-color lyr lyrColor)
)
)
) ; end lambda
)
all ; your file list ( you can change this into an path )
t
)
(princ
(strcat
"\n--> Drawing: " (car x)
(if (vl-catch-all-error-p (cdr x))
(strcat "\n Error: " (vl-catch-all-error-message (cdr x)))
"\nSuccessful."
)
)
)
)
(princ)
)
Kind Regards
Solved! Go to Solution.
