TheSwamp
Code Red => AutoLISP (Vanilla / Visual) => Topic started by: Dommy2Hotty on February 02, 2006, 09:34:25 AM
-
Is there a way to search a directory of about 100 drawings and return which ones reference a .shx file?
-
The dot-pair for DXF 3 of the Style < iterate the style table >
just a sec ...
-
The dot-pair for DXF 3 of the Style < iterate the style table >
just a sec ...
:?
-
This :
(mapcar '(lambda (StyleName) (cdr (assoc 3 (entget (tblobjname "STYLE" StyleName)))))
(ai_table "STYLE" 0)
)
returns something like this
("ROMANS" "ISOCP" "ISOCP" "ISO3098B.shx" "ARIAL.TTF" "isocp.shx" "isocp.shx" "isocp.shx" "isocp.shx" "isocp.shx" "isocp.shx" "ARIAL.TTF" "archs.shx" "ROMAND" "ISOCP.shx" "isocp.shx" "isocp.shx" "isocp.shx" "ISOCP" "ISOCP" "ISOCP" "ISOCP" "isocp.shx" "ISOCP" "ISOCP" "ISOCP" "txt")
which you could parse ..
-
which you could parse ..
If I knew how, or what parse means...I don't have a full library of coding knowledge, just enough to get me in trouble.
Here's what I got:
("EBSIMPLX.shx" "SIMPLEX.shx" "romans.shx" "C:\\ACAD\\PRGM\\FONTS\\SIMPLEX.SHX"
"EBSIMPLX.shx" "romans.shx" "simplex.shx" "bold2.shx" "SIMPLEX.shx"
"simplex.shx" "simplex.shx" "h777lt.shx" "romans.shx"
"C:\\ACAD\\PRGM\\FONTS\\SIMPLEX.SHX" "EBSIMPLX.shx" "EBSIMPLX.shx" "h777lt.shx"
"C:\\ACAD\\PRGM\\FONTS\\SIMPLEX.SHX" "EBSIMPLX.shx" "EBSIMPLX.shx"
"EBSIMPLX.shx" "h777lt.shx" "WWFSLAB.shx" "C:\\ACAD\\PRGM\\FONTS\\SIMPLEX.SHX"
"EBSIMPLX.shx")
I want to know what is referencing the WWFSLAB.shx file (because we don't have it).
-
Visit my homepage -> Free Stuff and search for 'VxGetTextStyles'...
For getting the file list use (vl-directory-files "C:\\TheDirectoryToScan" "*.dwg")
To open the dwg's use ObjectDBX
Modify my function for the document object from ObjectDBX:
(defun VxGetTextStyles (Doc / StyLst)
(vlax-for Sty (vla-get-TextStyles Doc)
...
-
Written on the fly:
Now tested and finished... :-)
(defun C:ScanTextFonts ( / AcaObj CurFld DbxObj FilLst FndFlg ObjStr StyLst
TmpFnm)
; Notes:
; - For A2k-A2k2 you need to register axdb15.dll by regsvr32, no need
; to do that for A2k4+
(setq AcaObj (vlax-get-acad-object)
ObjStr (if (< (atof (getvar "ACADVER")) 16.0)
"ObjectDBX.AxDbDocument"
"ObjectDBX.AxDbDocument.16"
)
Me:Fnm (cond (Me:Fnm) ("txt"))
CurFld (MeBrowseFolder "Select a drawing Folder")
TmpFnm (getstring T (strcat "\nFont name to search <" Me:Fnm ">: "))
Me:Fnm (cond ((eq TmpFnm "") Me:Fnm) (TmpFnm))
)
(cond
((not CurFld))
((not (setq FilLst (vl-directory-files CurFld "*.dwg")))
(alert "No drawing(s) found in this folder.")
)
((vl-catch-all-error-p
(setq DbxObj (vl-catch-all-apply
'vla-GetInterfaceObject (list AcaObj ObjStr)
)
)
)
(alert "Error on creating ObjectDBX object.")
)
(T
(princ (strcat "\n" (itoa (length FilLst)) " Drawings found..."))
(princ (strcat "\nFollowing drawing(s) contain the font " Me:Fnm ":"))
(foreach Fil (mapcar '(lambda (l) (strcat CurFld "\\" l)) FilLst)
(if (not
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-Open (list DbxObj Fil :vlax-true))
)
)
(progn
(setq StyLst (mapcar 'cdr (MeGetTextStyles DbxObj))
StyLst (mapcar 'strcase StyLst)
)
(if (apply 'or
(mapcar
'(lambda (l) (wcmatch l (strcat "*" (strcase Me:Fnm) "*")))
StyLst
)
)
(princ (strcat "\n" (setq FndFlg Fil)))
)
)
)
)
(if (not FndFlg)
(princ "\nNo drawing(s) with font " Me:Fnm " found.")
)
(textscr)
(vlax-release-object DbxObj)
)
)
(princ)
)
;
; == Function MeBrowseFolder
; Opens the standard folder dialog.
; Copyright:
; ©2005 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
; Tit = Box title [STR]
; Return [Type]:
; > Selected folder [STR]
; > False if cancelled [BOOLEAN]
; Notes:
; - Credits to Tony Tanzillo
;
(defun MeBrowseFolder (Tit / AcaObj ShlObj FldObj RetVal)
(setq AcaObj (vlax-get-acad-object)
ShlObj (vla-getInterfaceObject AcaObj "Shell.Application")
FldObj (vlax-invoke-method ShlObj
'BrowseForFolder (vla-get-HWND AcaObj) Tit 0
)
)
(vlax-release-object ShlObj)
(if FldObj
(progn
(setq RetVal (vlax-get-property
(vlax-get-property FldObj 'Self)
'Path
)
)
(vlax-release-object FldObj)
RetVal
)
)
)
;
; -- Function MeGetTextStyles
; Returns a list of all text style names and her font files.
; Copyright:
; ©2001 MENZI ENGINEERING GmbH, Switzerland
; Arguments [Type]:
; Doc = Document object [VLA-OBJECT]
; Return [Type]:
; > Dotted pair list '(("StyleName" . "FontFile")...) [LIST]
; Notes:
; - None
;
(defun MeGetTextStyles (Doc / StyLst)
(vlax-for Sty (vla-get-TextStyles Doc)
(setq StyLst (cons
(cons
(vla-get-Name Sty)
(vla-get-FontFile Sty)
)
StyLst
)
)
)
(reverse StyLst)
)
-
I've made some modifications and completions...
-
If you pass the first function a directory like (dbx-shx "c:/acad/lisp") it will print the drawing names and the shx fonts in each file.
Peter
(defun DBX-SHX (strDirectory / lstFiles objDBXDocument)
(if (setq lstFiles (vl-directory-files strDirectory "*.dwg"))
(foreach strFile lstFiles
(dbx-shx2 (strcat strDirectory "/" strFile))
)
)
)
(defun DBX-SHX2 (strDrawingName / objTextStyle)
(print strDrawingName)
(if (not objDBXDocument)
(setq objDBXDocument (vla-GetInterfaceObject
(vlax-get-acad-object)
"ObjectDBX.AxDbDocument.16"; The .16 is for 2004
)
)
)
(if strDrawingName
(progn
(vla-open objDBXDocument (findfile strDrawingName))
(vlax-for objTextStyle
(vla-get-textstyles
(vla-get-activedocument
(vlax-get-acad-object)
)
)
; (print (entget (vlax-vla-object->ename objTextStyle)))
(if (or (not (vl-filename-extension
(vla-get-fontfile objTextStyle)
)
)
(= (strcase
(vl-filename-extension
(vla-get-fontfile objTextStyle)
)
)
".SHX"
)
)
(print (vla-get-fontfile objTextStyle))
)
)
)
)
)
-
Hmmmm...
Does it make sense to write and test a solution to kill time?... just brood... :?