插入相对路径的外部参照，高手们帮助优化优化
本帖最后由 bloodtempt 于 2014-11-10 15:22 编辑(defun c:tt ( / ent elist blkdef path)
(vl-load-com)
(command "-xref" "A" (getfiled "选择要编辑的文件" (getvar "DWGPREFIX") "dwg" 0) (getpoint "指定插入点") "1" "" "0")
(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))))
(setq path (vla-get-path blkdef)) ;_取得外部参照的路径
(setq path (vl-filename-base path)) ;_去掉文件的路径和扩展名，返回文件的名称
(vla-put-path blkdef (strcat ".\\" path ".dwg")) ;_参照图块路径改为“相对路径
(command "_xref" "r" "*")
(princ)
)如何把command命令变为vlx形式？
不错，非常好用。 谢谢分享，学习了 无法使用，错误信息：
输入中的点位置不正确 本帖最后由 wudechao 于 2020-10-27 08:00 编辑
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:tt (/ 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)
)
wudechao 发表于 2020-10-26 08:52
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:tt (/ fi ...
感谢完善！！！ wudechao 发表于 2020-10-26 08:52
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:tt (/ fi ...
好用，特来表示感谢。 wudechao 发表于 2020-10-26 08:52
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:tt (/ fi ...
请问您这个代码，只能给添加dwg格式的外部参照，能不能扩展到PDF、IMG、PNG 这几个文件上呢？ wudechao 发表于 2020-10-26 08:52
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:tt (/ fi ...
感谢大佬分享
页:
[1]