查找一个指定目录下所有DWG文件中使用过的SHX文件名

newer · 发表于 2017-7-19 14:58:41

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(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 ver1)
(print strDrawingName)
(if (not objDBXDocument)
(setq objDBXDocument
(vla-GetInterfaceObject
(vlax-get-acad-object)
(if (< (setq ver1 (atoi (getvar 'acadver)))
16
)
"objectdbx.axdbdocument"
(strcat "objectdbx.axdbdocument."
(itoa ver1
)
)
)
)
)
)
(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))
)
)
)
)
)

(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 ver1) 
  (print strDrawingName) 
  (if (not objDBXDocument) 
    (setq objDBXDocument 
           (vla-GetInterfaceObject 
             (vlax-get-acad-object) 
             (if (< (setq ver1 (atoi (getvar 'acadver))) 
                    16 
                 ) 
               "objectdbx.axdbdocument" 
               (strcat "objectdbx.axdbdocument." 
                       (itoa ver1 
                       ) 
               ) 
             ) 
           ) 
    ) 
  ) 
  (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)) 
        ) 
      ) 
    ) 
  ) 
)

用法：
(DBX-SHX "d:\\abc") ;;查找d盘abc目录下所有DWG文件，打印出这些DWG里面定义的SHX文件。

账号		自动登录	找回密码
密码			立即注册

[每日一码] 查找一个指定目录下所有DWG文件中使用过的SHX文件名

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。