【K:CopySupportFile 】复制给定路径下给定格式的文件到支持路径
本帖最后由 kucha007 于 2023-3-25 01:31 编辑用来复制<acadiso.pat>或<acad.pat>等常用的文件：
;复制给定路径下给定格式的文件到支持路径
(defun K:CopySupportFile (/ K:GetSubPath k:GetSupportPath SearchPath FileTypes PathLst FNamLst pt ft)
(vl-load-com)
(setq SearchPath "C:\\WorkTools");存放常用文件的路径
(setq FileTypes '("*.pat" "*.shx" "*.lin"));搜索文件格式类型，可自行添加
(progn ;基础函数
;返回所有子路径
(defun K:GetSubPath (Path / Folder)
(mapcar
'(lambda (x)
(setq Folder (strcat Path "\\" x))
(cons Folder (apply 'append (K:GetSubPath Folder)))
)
(cddr (vl-directory-files Path nil -1))
)
)
;返回图案所在的路径; by Gu_xl
(defun k:GetSupportPath (/ Tmp PatNam)
(if (= 1 (getvar 'measurement)) ;公制
(setq PatNam (getenv "ISOHatch")) ;公制
(setq PatNam (getenv "ANSIHatch")) ;英制
)
(if (setq Tmp (findfile (getenv "ISOHatch")))
(vl-filename-directory Tmp)
(progn
(setq Tmp (getvar 'roamablerootprefix))
(or (eq "\\" (substr Tmp (strlen Tmp)))
(setq Tmp (strcat Tmp "\\"))
)
(strcat Tmp "support")
)
)
)
(setq PathLst (apply 'append (cons (list SearchPath) (K:GetSubPath SearchPath))));获取所有路径
)
;-------------------
(if (vl-file-directory-p SearchPath);文件夹存在
(progn
(mapcar
'(lambda (pt)
(mapcar
'(lambda (ft)
(if (setq FNamLst (vl-directory-files pt ft 1))
(foreach fn FNamLst
(vl-file-copy (strcat pt "\\" fn) (strcat (k:GetSupportPath) "\\" fn) T)
)
)
)
FileTypes
)
)
PathLst
)
(while (> (getvar "CMDACTIVE") 0) (command PAUSE));等待前面的命令完成
(alert "文件已全部复制完成！")
)
(alert (strcat "文件夹<" SearchPath ">不存在"))
)
(princ)
)
可以这样用：
(if (= 6;YES
(ACET-UI-MESSAGE
"复制<acadiso.pat>等文件到支持路径?"
"Copy_Support_File"
(+ Acet:YESNO Acet:ICONQUESTION)
)
)
(K:CopySupportFile)
(prin1)
)
本帖最后由 cchessbd 于 2023-3-25 14:06 编辑
您好，看到您有这个方面的研究，请教一下怎么添加线型到acadiso.lin呢？我是CAD 2008的用户。
我想加入自动运行，添加以下一些线型，但是我只需要添加一次，不需要每次都添加。
如果没有这些线型，那就添加。
;地质线型
*TLKC_BZHJZX, ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A,0,-0.35,[{shape138},ltypeshp.shx,s=0.3,r=0,x=-0.35,y=0],-2.65
*TLKC_BLDZJX,----x-----x----x-----x----x-----x--
A,6.35,-2.54,["x",TLStyle,s=2.54,r=0,x=-0.7,y=-1],-2.54
cchessbd 发表于 2023-3-25 14:04
您好，看到您有这个方面的研究，请教一下怎么添加线型到acadiso.lin呢？我是CAD 2008的用户。
我想加入 ...
我觉得你可以研究一下G版的程序，应该是差不多的原理？http://bbs.mjtd.com/forum.php?mod=viewthread&tid=91425&highlight=%CD%BC%B0%B8%2B%CC%EE%B3%E4
页:
[1]