插入相对路径的外部参照，高手们帮助优化优化

bloodtempt

2. (defun c:tt ( / ent elist blkdef path)
   
3.   (vl-load-com)
   
4.   (command "-xref" "A" (getfiled "选择要编辑的文件" (getvar "DWGPREFIX") "dwg" 0) (getpoint "指定插入点") "1" "" "0")
   
5.   (setq ent (entget (ssname (ssget "L" '((0 . "insert"))) 0)))
   
6. (setq obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 ent)))
   
7. )
   
8.           (setq elist (entget (tblobjname "block" (cdr (assoc 2 ent))))) ;_获取参照图块的图元表
   
9.           (setq blkdef (vlax-ename->vla-object (cdr (assoc 330 elist))))
   
10.           (setq path (vla-get-path blkdef)) ;_取得外部参照的路径
    
11.           (setq path (vl-filename-base path)) ;_去掉文件的路径和扩展名，返回文件的名称
    
12.           (vla-put-path blkdef (strcat ".\" path ".dwg")) ;_参照图块路径改为“相对路径
    
13.   (command "_xref" "r" "*")
    
14.   (princ)
    
15. )

(defun c:tt ( / ent elist blkdef path)<br />   (vl-load-com)<br />   (command "-xref" "A" (getfiled "选择要编辑的文件" (getvar "DWGPREFIX") "dwg" 0) (getpoint "指定插入点") "1" "" "0")<br />   (setq ent (entget (ssname (ssget "L" '((0 . "insert"))) 0)))<br /> (setq obj (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (cdr (assoc 2 ent)))<br /> )<br />           (setq elist (entget (tblobjname "block" (cdr (assoc 2 ent))))) ;_获取参照图块的图元表<br />           (setq blkdef (vlax-ename->vla-object (cdr (assoc 330 elist))))<br />           (setq path (vla-get-path blkdef)) ;_取得外部参照的路径<br />           (setq path (vl-filename-base path)) ;_去掉文件的路径和扩展名，返回文件的名称<br />           (vla-put-path blkdef (strcat ".\" path ".dwg")) ;_参照图块路径改为“相对路径<br />   (command "_xref" "r" "*")<br />   (princ)<br /> )

如何把command命令变为vlx形式？

rhett_sky

不错，非常好用。

happy336

谢谢分享，学习了

20060510412

无法使用，错误信息：
输入中的点位置不正确

wudechao

;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(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)
)

bloodtempt

wudechao 发表于 2020-10-26 08:52
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:tt (/ fi ...

感谢完善！！！

moshouhot

wudechao 发表于 2020-10-26 08:52
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:tt (/ fi ...

好用，特来表示感谢。

moshouhot

wudechao 发表于 2020-10-26 08:52
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:tt (/ fi ...

请问您这个代码，只能给添加dwg格式的外部参照，能不能扩展到PDF、IMG、PNG 这几个文件上呢？

菜鸟初来乍到

wudechao 发表于 2020-10-26 08:52
;改一下，增加如果参照存在，只改路径，增加支持父目录，子目录，孙目录。。。。。。。
(defun c:tt (/ fi ...

感谢大佬分享