[求助]统计图纸-------三问为什么？
;;下面的程序是想统计统计图纸,我在自己的电脑能运行，在别的电脑上就不行了;;各位帮帮忙呀！！！
;;******************************************** [目的] 统计图纸 (分两种况)
;;1 图名定义在块中
;;2 文件名为图名
;;3 by 自贡黄明儒 2012.9.26
(defun C:StatisticDrawings (/ *ACAD* *DOC* *DOCS* *LOUTS* ENT ENT1 ENTLIST TAGNAME)
(Defun LI_item (N E) (CDR (Assoc N E)))
;;1 [功能] 路径下所有dwg文件(包括子文件夹内的)
;;若图名是块中一个属性,点取块(因为每个人定义可能不一样);否则图名为文件名
;; [功能] 路径下dwg文件列表
(defun PathAllDwgS (/ PROFIX)
;; [功能] 路径下dwg文件列表
(defun PathAllDwg (PROFIX / DIRECTORY LISPATH1 PATH1)
(setq Path1 (vl-directory-files PROFIX "*.dwg" 1))
(foreach n Path1
(setq
lisPath1
(cons (apply 'strcat (list PROFIX "\\" n)) lisPath1)
)
)
(setq directory (cddr (vl-directory-files PROFIX nil -1)))
(foreach n directory
(setq
lisPath1
(append (PathAllDwg (strcat PROFIX "\\" n)) lisPath1)
)
)
(acad_strlsort lisPath1)
)
(setq PROFIX (vl-filename-directory (getvar "DWGPREFIX")))
(PathAllDwg PROFIX)
)
;;2 [功能] 返回非打开文件块指定属性值列表
;;下面程序处理非打开文档(有打开文档,出错)
(defun NotOpenfiles
(flielist tagname / DBXDOC ATTS LOUTS VALS VERKEY)
(setq verkey (if (> (atoi (getvar "AcadVer")) 15)
".16"
""
)
)
(setq DBXDOC (vla-getinterfaceobject
(vlax-get-acad-object)
(strcat "ObjectDBX.AxDbDocument" verkey)
)
)
(foreach fname flielist
(vla-open DBXDOC fname :vlax-false)
(setq LOUTS (vla-get-Layouts DBXDOC))
(vlax-for layout LOUTS
(vlax-for i (vla-get-block layout)
(if ;;(and
(= (vla-get-objectname i) "AcDbBlockReference")
;;(= (strcase (vla-get-name i)) (strcase bn))
;;)
(if (and
(= (vla-get-hasattributes i) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes i)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if
(= (strcase tagname)
(strcase (vla-get-tagstring tag))
)
(setq vals (cons (vla-get-TextString tag) vals))
)
)
)
)
)
)
;;(vla-close DBXDOC)为什么不行?
;;(vlax-invoke DBXDOC 'close)?为什么不行?
;;(vlax-release-object DBXDOC)为什么不能放在这儿?
)
(vlax-release-object DBXDOC)
vals
)
;;3 [功能] 返回打开文件块指定属性值列表
(defun DoOpenfiles (FLIELIST tagname / ATTS DOC DOCNAME LOUTS N VALS)
(setq n -1)
(repeat (vlax-get-property *DOCS* 'count)
(setq doc (vla-item *DOCS* (setq n (1+ n))))
(setq LOUTS (vla-get-Layouts doc))
(setq docname
(strcat
(vlax-get-property doc 'Path)
"\\"
(MJ:Name doc)
)
)
(if (member docname FLIELIST)
(vlax-for layout LOUTS
(vlax-for i (vla-get-block layout)
(if ;;(and
(= (vla-get-objectname i) "AcDbBlockReference")
;;(= (strcase (vla-get-name i)) (strcase bn))
;;)
(if (and
(= (vla-get-hasattributes i) :vlax-true)
(safearray-value
(setq atts
(vlax-variant-value
(vla-getattributes i)
)
)
)
)
(foreach tag (vlax-safearray->list atts)
(if
(= (strcase tagname)
(strcase (vla-get-tagstring tag))
)
(setq vals (cons (vla-get-TextString tag) vals))
)
)
)
)
)
)
) ;end of
)
vals
)
;;4 [功能] 对象名称
(defun MJ:Name (obj)
(if (vlax-property-available-p obj 'Name)
(vlax-get-property obj 'Name)
"<NONE_NAME>"
)
)
;;5 [功能] 打开文件名列表
;;verbose:T,nil
(defun MJ:DocsList (verbose / docname out)
(vlax-for each *DOCS*
(if verbose
(setq docname
(strcat
(vlax-get-property each 'Path)
"\\"
(MJ:Name each)
)
)
(setq docname (MJ:Name each))
)
(setq out (cons docname out))
)
(reverse out)
)
;;6 [功能] 剔除表元素 By 无痕
;;提示; 等同于: (vl-remove at list)
(defun MJ:removeat (at lst)
(apply 'append (subst nil (list at) (mapcar 'list lst)))
)
;;7 [功能] 图名为定义为块之属性
(defun HH:ShowBlockFiles
(tagname / DCL_FILE FILE FLIELIST VALS VALS1 VALS2)
;;路径下所有dwg文件(包括子文件夹内的)
(setq flielist (PathAllDwgS))
(setq vals1 (DoOpenfiles flielist tagname))
;;打开的文件要去除
(foreach one (MJ:DocsList T)
(if (member one flielist)
(setq flielist (MJ:removeat one flielist))
)
)
(setq vals2 (NotOpenfiles flielist tagname))
(setq vals (append vals1 vals2))
(setq Dcl_File (vl-filename-mktemp nil nil ".txt"))
(setq file (open Dcl_File "w"))
(foreach n vals
(write-line n FILE)
)
(close FILE)
(startapp "notepad" Dcl_File)
(vl-file-delete Dcl_File)
)
;;8 [功能] 图名为文件名
(defun HH:ShowFiles (/ DCL_FILE FILE FNAME)
(setq Dcl_File (vl-filename-mktemp nil nil ".txt"))
(setq file (open Dcl_File "w"))
;;(setq FILE (getfiled "***Lisp文件保存到***" "" "txt" 1))
(foreach n (PathAllDwgS)
(write-line (cadr (fnsplitl n)) FILE)
)
(close FILE)
(startapp "notepad" Dcl_File)
(vl-file-delete Dcl_File)
)
;;9 本程序主程序
(vl-load-com)
(setq *ACAD* (vlax-get-acad-object)
*DOC* (vla-get-ActiveDocument *ACAD*)
*DOCS* (vla-get-Documents *ACAD*)
*LOUTS* (vla-get-Layouts *DOC*)
)
(setq ent1 (entsel "\n 点取图名:"))
(princ "\n >>>>>>>>>>请稍候...............................")
(princ)
(setq ent (nentselp (cadr ent1)))
(setq entlist (entget (car ent)))
(if (equal (LI_item 0 entlist) "ATTRIB")
(progn (setq tagname (cdr (assoc 2 entlist)))
(HH:ShowBlockFiles tagname)
;不打开文件,查找里面块之属性
)
(HH:ShowFiles) ;显示文件名
)
(princ)
)
;;******************************************** [目的] 统计图纸 (分两种况)
上面的程序要删除 (vl-file-delete Dcl_File)才行，按理说它在startapp之后，不删也可以呀？
upupupupupup~ 谢谢楼主，我下载了，研究一下 好东西，好好学习
页:
[1]