e2002 发表于 2003-9-15 16:59:00

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

如何才能用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)) ;; ???????

自贡黄明儒 发表于 2014-10-23 14:08:41

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

mccad 发表于 2003-9-15 21:28:00

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

mccad 发表于 2003-9-16 11:45:00

试过了，完全可能实现。
以下是VBA的方法，你可以把它改到VL中：
Sub Add_layout()
    Dim LayName As String
    LayName = "明经"
    Dim NewLayout As AcadLayout
    Set NewLayout = ThisDrawing.Layouts.Add(LayName)
    NewLayout.CopyFrom ThisDrawing.ActiveLayout
    Dim ActLayBlk As AcadBlock
    Dim NewLayBLk As AcadBlock
    Set ActLayBlk = ThisDrawing.ActiveLayout.Block
    Set NewLayBLk = NewLayout.Block
    Dim EntCount As Integer
    EntCount = ActLayBlk.Count
    Dim Ent() As AcadObject
    ReDim Ent(EntCount - 1) As AcadObject
    Dim i As Integer
    For i = 0 To EntCount - 1
      Set Ent(i) = ActLayBlk(i)
    Next
    ThisDrawing.CopyObjects Ent, NewLayBLk
    ThisDrawing.ActiveLayout = NewLayout
End Sub

xazhji 发表于 2003-9-16 11:53:00

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

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

什么都有呀！

e2002 发表于 2003-9-16 12:06:00

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

xazhji 发表于 2003-9-16 12:13:00

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

龙龙仔 发表于 2003-9-16 12:40:00

因為要透明執行

xazhji 发表于 2003-9-16 12:48:00

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

龙龙仔 发表于 2003-9-16 16:48:00

有待改進

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

e2002 发表于 2003-9-17 15:51:00

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


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

(vlax-for item SourceLayoutBlock
    (vla-copyobjects
      CDoc
      (vlax-safearray-fill
        (vlax-make-safearray vlax-vbobject '(0 . 0))
        (list item)
      )
      NewLayoutBlock
    )       
)

(vla-CopyFrom NewLayout SourceLayout)
(mapcar 'vlax-release-object (list SourceLayoutBlock NewLayoutBlock NewLayout))
(setq return nil)
)
页: [1] 2
查看完整版本: [求助]如何才能用VL创建一个现存的Layout的Copy ?