[求助]如何才能用VL创建一个现存的Layout的Copy ?

e2002

如何才能用VL创建一个现存的Layout的Copy,产生一个和用layout命令的copy选项的到相同结果的NewLayout ?
迷惑中...

一下sample code怎么不能成功?

(setq AcadObject (vlax-get-acad-object))
(setq CDoc (vla-get-ActiveDocument AcadObject))
(setq Layouts (vla-get-Layouts CDoc))
(setq Layouts-list '() )
(setq CLayout (vla-get-ActiveLayout CDoc))
(setq PlotConfigs (vla-get-PlotConfigurations CDoc))
(setq PlotConfigs-list '())
(vlax-for item PlotConfigs
  (setq PlotConfigs-list (cons item PlotConfigs-list))
)

(setq NewLayout (vla-Add Layouts "NewLayout"))
(vla-CopyFrom NewLayout (nth 0 PlotConfigs-list)) ;; ???????

自贡黄明儒

顶起来 ，这么好的东西不能被人遗忘了。

mccad

只能复制布局的页面配置部分，而不能复制布局中视口。
对于视口的操作，在对象模型中是存在缺陷的，无法完成在交互操作中的很多操作，而且经常会得到一些与交互操作不相同的结果。

mccad

试过了，完全可能实现。
以下是VBA的方法，你可以把它改到VL中：

2. Sub Add_layout()
   
3.     Dim LayName As String
   
4.     LayName = "明经"
   
5.     Dim NewLayout As AcadLayout
   
6.     Set NewLayout = ThisDrawing.Layouts.Add(LayName)
   
7.     NewLayout.CopyFrom ThisDrawing.ActiveLayout
   
8.     Dim ActLayBlk As AcadBlock
   
9.     Dim NewLayBLk As AcadBlock
   
10.     Set ActLayBlk = ThisDrawing.ActiveLayout.Block
    
11.     Set NewLayBLk = NewLayout.Block
    
12.     Dim EntCount As Integer
    
13.     EntCount = ActLayBlk.Count
    
14.     Dim Ent() As AcadObject
    
15.     ReDim Ent(EntCount - 1) As AcadObject
    
16.     Dim i As Integer
    
17.     For i = 0 To EntCount - 1
    
18.         Set Ent(i) = ActLayBlk(i)
    
19.     Next
    
20.     ThisDrawing.CopyObjects Ent, NewLayBLk
    
21.     ThisDrawing.ActiveLayout = NewLayout
    
22. End Sub
    

Sub Add_layout()<br />     Dim LayName As String<br />     LayName = "明经"<br />     Dim NewLayout As AcadLayout<br />     Set NewLayout = ThisDrawing.Layouts.Add(LayName)<br />     NewLayout.CopyFrom ThisDrawing.ActiveLayout<br />     Dim ActLayBlk As AcadBlock<br />     Dim NewLayBLk As AcadBlock<br />     Set ActLayBlk = ThisDrawing.ActiveLayout.Block<br />     Set NewLayBLk = NewLayout.Block<br />     Dim EntCount As Integer<br />     EntCount = ActLayBlk.Count<br />     Dim Ent() As AcadObject<br />     ReDim Ent(EntCount - 1) As AcadObject<br />     Dim i As Integer<br />     For i = 0 To EntCount - 1<br />         Set Ent(i) = ActLayBlk(i)<br />     Next<br />     ThisDrawing.CopyObjects Ent, NewLayBLk<br />     ThisDrawing.ActiveLayout = NewLayout<br /> End Sub<br />

xazhji

为什么想的这么复杂？这样不行？

.....
(command "-layout"  "c"  layname1 layname2)
......

什么都有呀！

e2002

这里的意思就是不能使用command来作这个事啊

xazhji

为什么不能？此时对话框未关闭？

龙龙仔

因為要透明執行

xazhji

如何透明？象pan zoom ？在执行其他命令时执行？到底什么效果？我也在迷惑中.....

龙龙仔

有待改進

2. 
   
3. (defun TT (NEWLAYOUTNAME)
   
4.   (setq ACADOBJECT (vlax-get-acad-object))
   
5.   (setq CDOC (vla-get-activedocument ACADOBJECT))
   
6.   (setq LAYOUTS (vla-get-layouts CDOC))
   
7.   (setq CLAYOUT (vla-get-activelayout CDOC))
   
8.   (setq CLAYOUT_BLK (vla-get-block CLAYOUT))
   
9.   (setq NEWLAYOUT (vla-add LAYOUTS NEWLAYOUTNAME))
   
10.   (setq NEWLAYOUT_BLK (vla-get-block NEWLAYOUT))
    
11.   (vlax-for ENT        CLAYOUT_BLK
    
12.     (vla-copyobjects
    
13.       CDOC
    
14.       (vlax-safearray-fill
    
15.         (vlax-make-safearray
    
16.           vlax-vbobject
    
17.           '(0 . 0)
    
18.         )
    
19.         (list ENT)
    
20.       )
    
21.       NEWLAYOUT_BLK
    
22.     )
    
23.   )
    
24.   (vla-copyfrom NEWLAYOUT CLAYOUT)
    
25.   (princ)
    
26. )
    

<br /> (defun TT (NEWLAYOUTNAME)<br />   (setq ACADOBJECT (vlax-get-acad-object))<br />   (setq CDOC (vla-get-activedocument ACADOBJECT))<br />   (setq LAYOUTS (vla-get-layouts CDOC))<br />   (setq CLAYOUT (vla-get-activelayout CDOC))<br />   (setq CLAYOUT_BLK (vla-get-block CLAYOUT))<br />   (setq NEWLAYOUT (vla-add LAYOUTS NEWLAYOUTNAME))<br />   (setq NEWLAYOUT_BLK (vla-get-block NEWLAYOUT))<br />   (vlax-for ENT        CLAYOUT_BLK<br />     (vla-copyobjects<br />       CDOC<br />       (vlax-safearray-fill<br />         (vlax-make-safearray<br />           vlax-vbobject<br />           '(0 . 0)<br />         )<br />         (list ENT)<br />       )<br />       NEWLAYOUT_BLK<br />     )<br />   )<br />   (vla-copyfrom NEWLAYOUT CLAYOUT)<br />   (princ)<br /> )<br />

e2002

请问龙哥 :
这个函数为什么按照以下注释掉的部分编写不行呢?

2. 
   
3. defun lkpt:Layout:MultiCopy:CopyFrom (SourceLayout sNewLayoutName /)
   
4.   (setq SourceLayoutBlock (vla-get-Block SourceLayout)
   
5. ;;;        iCount (vla-get-Count SourceLayoutBlock)
   
6. ;;;        SourceLayoutBlock-Objects-list '()
   
7.   )
   
8. ;;;  (vlax-for item SourceLayoutBlock
   
9. ;;;    (setq SourceLayoutBlock-Objects-list (cons item SourceLayoutBlock-Objects-list))
   
10. ;;;  )
    
11.   (setq NewLayout (vla-Add Layouts sNewLayoutName)
    
12.         NewLayoutBlock (vla-get-Block NewLayout)
    
13.   )
    
14. ;;;  (vla-copyobjects
    
15. ;;;    CDoc
    
16. ;;;    (vlax-safearray-fill
    
17. ;;;      (vlax-make-safearray
    
18. ;;;        vlax-vbobject
    
19. ;;;        (cons 0 (1- iCount))
    
20. ;;;      )
    
21. ;;;      SourceLayoutBlock-Objects-list
    
22. ;;;    )
    
23. ;;;    NewLayoutBlock
    
24. ;;;  )
    
25.   
    
26.   (vlax-for item SourceLayoutBlock
    
27.     (vla-copyobjects
    
28.       CDoc
    
29.       (vlax-safearray-fill
    
30.         (vlax-make-safearray vlax-vbobject '(0 . 0))
    
31.         (list item)
    
32.       )
    
33.       NewLayoutBlock
    
34.     )       
    
35.   )
    
36.   
    
37.   (vla-CopyFrom NewLayout SourceLayout)
    
38.   (mapcar 'vlax-release-object (list SourceLayoutBlock NewLayoutBlock NewLayout))
    
39.   (setq return nil)
    
40. )
    

<br /> defun lkpt:Layout:MultiCopy:CopyFrom (SourceLayout sNewLayoutName /)<br />   (setq SourceLayoutBlock (vla-get-Block SourceLayout)<br /> ;;;        iCount (vla-get-Count SourceLayoutBlock)<br /> ;;;        SourceLayoutBlock-Objects-list '()<br />   )<br /> ;;;  (vlax-for item SourceLayoutBlock<br /> ;;;    (setq SourceLayoutBlock-Objects-list (cons item SourceLayoutBlock-Objects-list))<br /> ;;;  )<br />   (setq NewLayout (vla-Add Layouts sNewLayoutName)<br />         NewLayoutBlock (vla-get-Block NewLayout)<br />   )<br /> ;;;  (vla-copyobjects<br /> ;;;    CDoc<br /> ;;;    (vlax-safearray-fill<br /> ;;;      (vlax-make-safearray<br /> ;;;        vlax-vbobject<br /> ;;;        (cons 0 (1- iCount))<br /> ;;;      )<br /> ;;;      SourceLayoutBlock-Objects-list<br /> ;;;    )<br /> ;;;    NewLayoutBlock<br /> ;;;  )<br />   <br />   (vlax-for item SourceLayoutBlock<br />     (vla-copyobjects<br />       CDoc<br />       (vlax-safearray-fill<br />         (vlax-make-safearray vlax-vbobject '(0 . 0))<br />         (list item)<br />       )<br />       NewLayoutBlock<br />     )        <br />   )<br />   <br />   (vla-CopyFrom NewLayout SourceLayout)<br />   (mapcar 'vlax-release-object (list SourceLayoutBlock NewLayoutBlock NewLayout))<br />   (setq return nil)<br /> )<br />