vba cad布局复制vba cad布局复制
Dim CADapp As Object
Public Function IVersion() As String 'È??æ??ºÅ
On Error Resume Next
Set CADapp = GetObject(, "AutoCAD.Application")
If Err.Number <> 0 Then
Set CADapp = CreateObject("AutoCAD.Application")
End If
CADapp.Visible = True
...
vba cad布局复制
Dim CADapp As Object
Public Function IVersion() As String 'È??æ??ºÅ
On Error Resume Next
Set CADapp = GetObject(, "AutoCAD.Application")
If Err.Number <> 0 Then
Set CADapp = CreateObject("AutoCAD.Application")
End If
CADapp.Visible = True
IVersion = Left(CADapp.Version, 2)
End Function
Public Function IobjDbx() As Object '?ñÈ??Ó?Ú?æ??
Version = IVersion
If CInt(Version) < 16 Then
Set IobjDbx =
CADapp.GetInterfaceObject("ObjectDBX.AxDbDocument")
Else
Set IobjDbx =
CADapp.GetInterfaceObject("ObjectDBX.AxDbDocument." & Version)
End If
End Function
Public Function layoutcopy(Documentobj As Object, SourcelayoutName As
String, TargetlayoutName As String) As Object '??ÖÆ???Ö
Dim mylayout As Object
Dim objArray() As Object
Dim ent() As Object
Dim lngCount As Long, i As Long
lngCount = Documentobj.Layouts(SourcelayoutName).Block.Count
Set mylayout =
CADapp.Application.activeDocument.Layouts.Add(TargetlayoutName)
If lngCount > 0 Then
ReDim objArray(0 To lngCount - 1)
For i = 0 To lngCount - 1
Set objArray(i) =
Documentobj.Layouts(SourcelayoutName).Block.Item(i)
Next
mylayout.CopyFrom Documentobj.Layouts(SourcelayoutName)
Documentobj.Database.CopyObjects objArray, mylayout.Block
Set layoutcopy = mylayout
End If
End Function
Sub Test()
Dim Documentobj As Object
Set Documentobj = IobjDbx
Documentobj.Open "c:\xxx.dwt"
layoutcopy Documentobj, "xxx.dwtÖÐ???ÖÃû?Æ", "Ö???ÐÂ???ÖÃû?Æ"
Set Documentobj = Nothing
Set CADapp = Nothing
End Sub
本文档为【vba cad布局复制】，请使用软件OFFICE或WPS软件打开。作品中的文字与图均可以修改和编辑，
图片更改请在作品中右键图片并更换，文字修改请直接点击文字进行修改，也可以新增和删除文档中的内容。
该文档来自用户分享，如有侵权行为请发邮件ishare@vip.sina.com联系网站客服，我们会及时删除。
[版权声明] 本站所有资料为用户分享产生，若发现您的权利被侵害，请联系客服邮件isharekefu@iask.cn，我们尽快处理。
本作品所展示的图片、画像、字体、音乐的版权可能需版权方额外授权，请谨慎使用。
网站提供的党政主题相关内容(国旗、国徽、党徽..)目的在于配合国家政策宣传，仅限个人学习分享使用，禁止用于任何广告和商用目的。
浙公网安备 33021202002483