社区 › Auto Lisp › 将一个外部参照附着到所有布局

Hippe013 发表于 2022-7-6 06:33:14

将一个外部参照附着到所有布局

大家好！
 
正如标题所述，我希望将外部参照附着到打开的图形中的每个布局。我目前正在使用Civil3D 2013。
 
我目前的代码如下：
 
(defun c:XREF-LAYOUT (/ fp xrname PS LOs AD)
(setq fp (getfiled "Select External Reference: " "" "dwg" 0))
(if (/= nil fp)
   (progn
   (setq xrname (vl-filename-base fp))
   (setq PS (vla-get-paperspace (setq AD (vla-get-activedocument (vlax-get-acad-object)))))
   (setq LOs (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object))))
   (vlax-for lo LOs
(if (/= "Model" (vla-get-name lo))
(progn
    (vlax-put-property AD 'ActiveLayout lo)
    (setq xr (vla-AttachExternalReference PS fp xrname (vlax-3d-point (list 0 0 0)) 1. 1. 1. 0. :vlax-false))
)
)
   )
   )
)
)
 
我一直遇到这个错误：
 
; 错误：发生异常：0xC0000005（访问冲突）
; 警告：未知异常时跳过了展开
 
任何帮助都将不胜感激。

Lee Mac 发表于 2022-7-6 07:07:39

试试这个：

(defun c:xrl ( / acd acl dwg ins xrn )
   (if (setq dwg (getfiled "Select XRef" "" "dwg" 16))
       (progn
         (setq acd (vla-get-activedocument (vlax-get-acad-object))
               acl (vla-get-activelayout acd)
               xrn (vl-filename-base dwg)
               ins (vlax-3D-point 0 0)
         )
         (vlax-for lay (vla-get-layouts acd)
               (if (/= "MODEL" (strcase (vla-get-name lay)))
                   (progn
                     (vla-put-activelayout acd lay)
                     (vla-attachexternalreference (vla-get-paperspace acd) dwg xrn ins 1.0 1.0 1.0 0.0 :vlax-false)
                   )
               )
         )
         (vla-put-activelayout acd acl)
       )
   )
   (princ)
)
(vl-load-com) (princ)

Hippe013 发表于 2022-7-6 07:20:51

嘿，李，
 
谢谢你的回复。虽然在这段时间里，我最终让它发挥了作用。我修改后的代码如下：
 


(defun c:xrl (/ fp xrname AD PS LO l PS)
(setq fp (getfiled "Get
Xref" "" "dwg" )
(setq xrname (vl-filename-base fp))
(setq
AD (vla-get-ActiveDocument (Vlax-get-acad-object)))
(setq LO
(vla-get-layouts AD))
(vlax-for l LO
   (if (/=
"Model" (vla-get-name l))
   
(progn
(vla-put-ActiveLayout AD l)
(princ (strcat "\n***"
(vla-get-name l) "***\n"))
(setq PS (vla-get-block l))
(setq
xr (vla-AttachExternalReference PS fp xrname (vlax-3d-point '(0 0 0)) 1. 1. 1.
0. :vlax-false))
)
   
)
   )
(princ)
)

Lee Mac 发表于 2022-7-6 07:40:45

以下是另一种避免切换布局的方法：

(defun c:xrl ( / acd dwg ins obj xrn )
   (if (setq dwg (getfiled "Select XRef" "" "dwg" 16))
       (progn
         (setq acd (vla-get-activedocument (vlax-get-acad-object))
               xrn (vl-filename-base dwg)
               ins (vlax-3D-point 0 0)
               obj (list (vla-attachexternalreference (vla-get-modelspace acd) dwg xrn ins 1.0 1.0 1.0 0.0 :vlax-false))
         )
         (vlax-for lay (vla-get-layouts acd)
               (if (/= "MODEL" (strcase (vla-get-name lay)))
                   (vlax-invoke acd 'copyobjects obj (vla-get-block lay))
               )
         )
         (vla-delete (car obj))
       )
   )
   (princ)
)
(vl-load-com) (princ)

查看完整版本: 将一个外部参照附着到所有布局