[编程交流] 将一个外部参照附着到所有布局

(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))
  )
)
     )
   )
 )
 )

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

(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)
 )

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