把参照绝对路径改为相对路径

pxt2001

绝对路径改相对路径，这个功能很好，哪位高手能完善程序，搞一个最终版本

mj0000

wudechao 发表于 2014-6-3 18:12
你这段代码好象不能修改参照路径更改后的图,比如:原来被参照的文件放在文件根目录下,现在改为子目录下.

我的图都在文件根目录下，看起来方便

clinber

楼主 你这个代码64位的cad2014用不了啊

spp_wall

怎么08也不能用！！！！！

clinber

命令: (LOAD "C:/Users/Administrator/Desktop/xl/参照.lsp") ; 错误: 输入的列表有缺陷

风流少年时

对于嵌套参照无效

mj0000

wudechao 发表于 2014-6-3 18:12
你这段代码好象不能修改参照路径更改后的图,比如:原来被参照的文件放在文件根目录下,现在改为子目录下.

改了下代码，支持子目录

2. ;;;;参照图块路径改为“相对路径” 且 自动重载XREF ---- 支持子目录
   
3. (defun C:Tools-BLK-XrefPathAutoLoad (/ ssg xpath i obj enl elist blkdef path n Sub_Path)
   
4.   (setq ssg (ssget "x" '((0 . "insert"))))
   
5.   (setq XPath (getvar "dwgprefix")) ;_取得当前文档路径
   
6.   (setq i 0)
   
7.   (setq n 0)
   
8.   (if ssg
   
9.     (repeat (sslength ssg)
   
10.       (setq obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (setq enl (entget (ssname ssg i)))))))
    
11.       (if (= (vla-get-isxref obj) :vlax-true) ;_判断给定的图块是否为XRef图块
    
12.         (progn
    
13.           ;;(vla-put-path obj (strcat xpath (vla-get-name obj) ".dwg"));_参照图块路径改为“绝对路径
    
14.           (setq elist (entget (tblobjname "block" (cdr (assoc 2 enl))))) ;_获取参照图块的图元表
    
15.           (setq blkdef (vlax-ename->vla-object (cdr (assoc 330 elist))))
    
16.           (setq path (vla-get-path blkdef)) ;_取得外部参照的路径
    
17.           (setq m (vl-string-mismatch XPath path 0 0 t)) ;_前面有多少个相同的字符
    
18.          (setq Sub_Path (substr path (1+ m))) ;获取图块参照路径的子串
    
19.           (vla-put-path blkdef (strcat ".\" Sub_Path)) ;_参照图块路径改为“相对路径”
    
20.           (setq n (1+ n))
    
21.         )
    
22.       )
    
23.       (setq i (1+ i))
    
24.     )
    
25.   )
    
26.   (if (> n 0)
    
27.     (progn
    
28.       (command "_xref" "r" "*")
    
29.       (prompt (strcat "\n总共有 " " (itoa n) " "个参照物体路径改为相对路径."))
    
30.     )
    
31.     (princ "\n**** 没有外部参照 或 外部参照没有加载 ****")
    
32.   )
    
33.   (princ)
    
34. )

;;;;参照图块路径改为“相对路径” 且 自动重载XREF ---- 支持子目录<br /> (defun C:Tools-BLK-XrefPathAutoLoad (/ ssg xpath i obj enl elist blkdef path n Sub_Path)<br />   (setq ssg (ssget "x" '((0 . "insert"))))<br />   (setq XPath (getvar "dwgprefix")) ;_取得当前文档路径<br />   (setq i 0)<br />   (setq n 0)<br />   (if ssg<br />     (repeat (sslength ssg)<br />       (setq obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 (setq enl (entget (ssname ssg i)))))))<br />       (if (= (vla-get-isxref obj) :vlax-true) ;_判断给定的图块是否为XRef图块<br />         (progn<br />           ;;(vla-put-path obj (strcat xpath (vla-get-name obj) ".dwg"));_参照图块路径改为“绝对路径<br />           (setq elist (entget (tblobjname "block" (cdr (assoc 2 enl))))) ;_获取参照图块的图元表<br />           (setq blkdef (vlax-ename->vla-object (cdr (assoc 330 elist))))<br />           (setq path (vla-get-path blkdef)) ;_取得外部参照的路径<br />           (setq m (vl-string-mismatch XPath path 0 0 t)) ;_前面有多少个相同的字符<br />          (setq Sub_Path (substr path (1+ m))) ;获取图块参照路径的子串<br />           (vla-put-path blkdef (strcat ".\" Sub_Path)) ;_参照图块路径改为“相对路径”<br />           (setq n (1+ n))<br />         )<br />       )<br />       (setq i (1+ i))<br />     )<br />   )<br />   (if (> n 0)<br />     (progn<br />       (command "_xref" "r" "*")<br />       (prompt (strcat "\n总共有 " " (itoa n) " "个参照物体路径改为相对路径."))<br />     )<br />     (princ "\n**** 没有外部参照 或 外部参照没有加载 ****")<br />   )<br />   (princ)<br /> )

mj0000

风流少年时 发表于 2015-9-5 13:18
对于嵌套参照无效

嵌套的得去嵌套文件修改

风流少年时

flytoday 发表于 2014-5-23 18:41
最讨厌设计院的图插入参照啦………你说没事搞布局与参照干嘛………烦不烦啊…………给别人电子档时候参照没 ...

看兄台这么回复应该不是设计院的，所以不知道一线设计人员的痛苦，真正做了才知道你这么说是多麽的搞笑和无知！

wudechao

clinber 发表于 2014-6-16 10:59
楼主 你这个代码64位的cad2014用不了啊

不好意思,ffg-getfolder函数复制少了一段代码.现在可以用了.