把参照绝对路径改为相对路径
本帖最后由 wudechao 于 2015-11-13 12:42 编辑;这几天修改别人的图,被参照图的绝对路径搞的很烦,一怒之下,写了一个改参照绝对路径为相对路径的lisp,还不够完满,运行效率不高,望高手帮修改指教.
(defun c:xfx (/ ss ffg k path files path2 path3 tmq m m2 n n2 total tst temp xpath i obj)
(vl-load-com)
(defun ffg-getfolder (msg startpath / winshell shfolder ffg path1 catchit)
(setq winshell (vlax-create-object "Shell.Application"))
(setq shfolder (vlax-invoke-method winshell 'browseforfolder 0 msg 1 startpath))
(setq catchit (vl-catch-all-apply '(lambda ()
(setq shfolder (vlax-get-property shfolder 'self))
(setq path1 (vlax-get-property shfolder 'path))
)
)
)
(if (vl-catch-all-error-p catchit)
nil
path1
)
)
(setvar "cmdecho" 0);主程序
(setq tst nil
m 0
ss (ssget "x" '((0 . "insert")))
)
(setq ffg (getvar "dwgprefix"));获取当前文件路径,
(setq k (vl-string-position 92 ffg 3 nil));查找第二个"\",减少选择路径对话框展开层数(删除硬盘符号和第一级目录),不会有人把文件放在硬盘根目录吧?
(setq path (ffg-getfolder "请选择参照文件所在的目录：" (substr ffg 1 k)));获取参照目录
(setq files (vl-directory-files path "*.dwg" 1));列出目录下所有文件
(setq m (vl-string-mismatch ffg path 0 0));前面有多少个相同的字符
(if (>= m (strlen ffg))
(progn
(setq tst t)
);_ 结束prgon
(progn
(setq n 0
n2 0
path3 ""
tmq (substr path 1 m)
);参照路径前面相同部分
(setq path2 (vl-string-left-trim tmq ffg));删除参照路径前面相同部分
(setq m2 (strlen path2))
(repeat m2
(setq temp (ascii (substr path2 (- m2 n) 1)))
(if (= temp 92)
(setq n2 (+ 1 n2))
);_ 结束if
(setq n (+ 1 n))
);_ 结束repeat
(repeat n2
(setq path3 (strcat ".." (chr 92) path3))
);_ 结束repeat
);_ 结束progn
);_ 结束if
(if tst
(setq xpath (vl-string-left-trim ffg path));删除参照前面的绝对路径,
(setq xpath (substr path (+ 1 m)))
)
(setq i 0
total 0
)
(repeat (sslength ss)
(setq obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget (ssname ss i))))))
(if (and
(= (vla-get-isxref obj) :vlax-true)
(vl-position (strcat (vla-get-name obj) ".dwg") files);参照图块是否在文件列表
)
(progn
(if (= xpath "")
(progn
(vla-put-path obj (strcat "." (chr 92) xpath (vla-get-name obj) ".dwg"))
);_ 结束progn
(progn
(if tst
(vla-put-path obj (strcat "." (chr 92) xpath (chr 92) (vla-get-name obj) ".dwg"));目录前面添加".\",目录后面添加"\"
(vla-put-path obj (strcat path3 xpath (chr 92) (vla-get-name obj) ".dwg"));
);_ 结束if
);_ 结束progn
);_ 结束if
(setq total (+ 1 total))
);_ 结束progn
);_ 结束if
(setq i (1+ i))
);_ 结束repeat
(command "-xref" "r" "*")
(if (> total 0)
(prompt (strcat "\n总共有 \" " (itoa total) " \"个参照物体路径改为相对路径."))
(prompt (strcat "\n未找到合适的参照物体路径!"))
)
(setvar "cmdecho" 1)
(princ)
);_ 结束defun 参照有时候很方便的，比如签名，出图日期，几十张图纸，改一个文件就可以搞定。 本帖最后由 flytoday 于 2014-5-23 18:42 编辑
最讨厌设计院的图插入参照啦………你说没事搞布局与参照干嘛………烦不烦啊…………给别人电子档时候参照没给打开缺这缺那……有时让人打印出来没内容………电子就是让人看滴舒服………别跟哥讲版权别跟哥讲院里不让给…借口很多…………电子图用于施工、预算比较方便点…给人方便给已方便………………希望那个什么什么设计别参照啦………别用布局啦
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:WBCZ (/ file scale1 pt0 i total ss filename ent obj elist blkdef)
(vl-load-com)
(defun ffg-path-xiangdui (path-file / tst m m2 ffg n n2 path3 path2 temp xpath path-xiangdui)
(setq tst nil
m 0
)
(setq ffg (getvar "dwgprefix"))
(setq m (vl-string-mismatch ffg path-file 0 0))
(if (>= m (strlen ffg))
(progn
(setq tst t)
)
(progn
(setq n 0
n2 0
path3 ""
)
(setq path2 (substr ffg (1+ m)))
(setq m2 (strlen path2))
(repeat m2
(setq temp (ascii (substr path2 (- m2 n) 1)))
(if (= temp 92)
(setq n2 (+ 1 n2))
)
(setq n (+ 1 n))
)
(repeat n2
(setq path3 (strcat ".." (chr 92) path3))
)
)
)
(setq xpath (substr path-file (1+ m)))
(if (= xpath "")
(progn
(setq path-xiangdui (strcat "." (chr 92) xpath))
)
(progn
(if tst
(setq path-xiangdui (strcat "." (chr 92) xpath))
(setq path-xiangdui (strcat path3 xpath))
)
)
)
path-xiangdui
)
(setvar "cmdecho" 0)
(if (setq file (getfiled "选择参照文件" (strcat (getvar "dwgprefix") "\\") "dwg" 16))
(progn
(if (= (tblobjname "block" (vl-filename-base file)) nil)
(progn
(setq scale1 (getvar "userr4"))
(if (equal scale1 0 0.0001)
(progn
(setq scale1 1.00)
(setvar "userr4" scale1)
)
)
(setq scale1 (getreal (strcat "\n请输入图形放大系数 < " (rtos scale1 2 2) " >:"))
scale1 (if scale1
scale1
(getvar "userr4")
)
)
(setq pt0 (getpoint "\n指定插入点:"))
)
(progn
(setq i 0
total 0
)
(setq ss (ssget "x" '((0 . "insert"))))
(repeat (sslength ss)
(setq obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (entget (ssname ss i))))))
(if (and
(= (vla-get-name obj) (vl-filename-base file))
(= (vla-get-isxref obj) :vlax-true)
)
(progn
(setq filename (vla-get-name obj))
(vla-put-path obj (ffg-path-xiangdui file))
(setq total (1+ total))
)
)
(setq i (1+ i))
)
(prompt (strcat "\n参照已经存在，仅仅修改路径。修改了 " (itoa total) " 个名称为\" " filename " \"的参照块路径."))
)
)
)
)
(if pt0
(progn
(command "-xref" "a" file "s" scale1 "r" "0.0" pt0)
(setq ent (entget (ssname (ssget "L" '((0 . "insert"))) 0)))
(setq obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 ent))))
(setq elist (entget (tblobjname "block" (cdr (assoc 2 ent)))))
(setq blkdef (vlax-ename->vla-object (cdr (assoc 330 elist))))
(vla-put-path blkdef (ffg-path-xiangdui file))
)
)
(command "_xref" "r" "*")
(setvar "cmdecho" 1)
(princ)
)
支持一下！ 傻才不用参照--- 我也到过，别人发的图，里面的外部参照就不发，到处缺图，烦 很实用 奇怪 需要其他的系统函数还是什么情况 为啥我cad2014加载不了呢 这么多代码啊，看看下面这个，论坛里面找来的，具体谁的忘了，时间有点久了;;;;参照图块路径改为“相对路径” 且 自动重载XREF
(defun C:Tools-BLK-XrefPathAutoLoad (/ ssg xpath i obj enl elist blkdef path n)
(setq ssg (ssget "x" '((0 . "insert"))))
(setq XPath (getvar "dwgprefix")) ;_取得当前文档路径
(setq i 0)
(setq n 0)
(if ssg
(repeat (sslength ssg)
(setq obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (setq enl (entget (ssname ssg i)))))))
(if (= (vla-get-isxref obj) :vlax-true) ;_判断给定的图块是否为XRef图块
(progn
;;(vla-put-path obj (strcat xpath (vla-get-name obj) ".dwg"));_参照图块路径改为“绝对路径
(setq elist (entget (tblobjname "block" (cdr (assoc 2 enl))))) ;_获取参照图块的图元表
(setq blkdef (vlax-ename->vla-object (cdr (assoc 330 elist))))
(setq path (vla-get-path blkdef)) ;_取得外部参照的路径
(setq path (vl-filename-base path)) ;_去掉文件的路径和扩展名，返回文件的名称
(vla-put-path blkdef (strcat ".\\" path ".dwg")) ;_参照图块路径改为“相对路径”
(setq n (1+ n))
)
)
(setq i (1+ i))
)
)
(if (> n 0)
(progn
(command "_xref" "r" "*")
(princ "\n**** Xref路径已改为“相对路径”****")
)
(princ "\n**** 没有外部参照 或 外部参照没有加载 ****")
)
(princ)
) mj0000 发表于 2014-5-30 13:11 static/image/common/back.gif
这么多代码啊，看看下面这个，论坛里面找来的，具体谁的忘了，时间有点久了
你这段代码好象不能修改参照路径更改后的图,比如:原来被参照的文件放在文件根目录下,现在改为子目录下.