|
The Code
Function GetWallStyles(Optional dwg As AcadDocument) As Variant
Dim Style As AecWallStyle, db As New AecArchBaseDocument, cnt As Long, sty() As String
If dwg Is Nothing Then
Set db = AecArchBaseApplication.ActiveDocument
Else
db.Init dwg
End If
cnt = 0
For Each Style In db.WallStyles
ReDim Preserve sty(cnt)
sty(cnt) = Style.Name
cnt = cnt + 1
Next
GetWallStyles = sty
End Function
Function GetDoorStyles(Optional dwg As AcadDocument) As Variant
Dim Style As AecDoorStyle, db As New AecArchBaseDocument, cnt As Long, sty() As String
If dwg Is Nothing Then
Set db = AecArchBaseApplication.ActiveDocument
Else
db.Init dwg
End If
cnt = 0
For Each Style In db.DoorStyles
ReDim Preserve sty(cnt)
sty(cnt) = Style.Name
cnt = cnt + 1
Next
GetDoorStyles = sty
End Function
Function GetWindowStyles(Optional dwg As AcadDocument) As Variant
Dim Style As AecWindowStyle, db As New AecArchBaseDocument, cnt As Long, sty() As String
If dwg Is Nothing Then
Set db = AecArchBaseApplication.ActiveDocument
Else
db.Init dwg
End If
cnt = 0
For Each Style In db.WindowStyles
ReDim Preserve sty(cnt)
sty(cnt) = Style.Name
cnt = cnt + 1
Next
GetWindowStyles = sty
End Function
Function GetWinAssemStyles(Optional dwg As AcadDocument) As Variant
Dim Style As AecWindowAssemblyStyle, db As New AecArchBaseDocument, cnt As Long, sty() As String
If dwg Is Nothing Then
Set db = AecArchBaseApplication.ActiveDocument
Else
db.Init dwg
End If
cnt = 0
For Each Style In db.WindowAssemblyStyles
ReDim Preserve sty(cnt)
sty(cnt) = Style.Name
cnt = cnt + 1
Next
GetWinAssemStyles = sty
End Function
Function GetMemberStyles(Optional dwg As AcadDocument) As Variant
Dim Style As AecsMemberStyle, db As New AecsBaseDatabase, cnt As Long, sty() As String
If dwg Is Nothing Then
db.Init ThisDrawing.Database
Else
db.Init dwg.Database
End If
cnt = 0
For Each Style In db.MemberStyles
ReDim Preserve sty(cnt)
sty(cnt) = Style.Name
cnt = cnt + 1
Next
GetMemberStyles = sty
End Function
Function getMvbStyles(Optional dwg As AcadDocument) As Variant
Dim Style As AecMVBlockStyle, db As New AecArchBaseDocument, cnt As Long, sty() As String
If dwg Is Nothing Then
Set db = AecArchBaseApplication.ActiveDocument
Else
db.Init dwg
End If
cnt = 0
For Each Style In db.MVBlockStyles
ReDim Preserve sty(cnt)
sty(cnt) = Style.Name
cnt = cnt + 1
Next
getMvbStyles = sty
End Function
Sub ImportWallStyleFrom(FromDwg As AcadDocument, ToDwg As AcadDocument, ByVal wsName As String)
Dim wObj As AecWall, owner As AcadModelSpace, wLst(0) As AcadObject, Copied
Set wObj = FromDwg.ModelSpace.AddCustomObject("AecWall")
wObj.StyleName = wsName
Set wLst(0) = wObj
Set owner = ToDwg.ModelSpace
ToDwg.Utility.Prompt vbCrLf & "Importing wall style <" & wsName & ">..."
Copied = FromDwg.CopyObjects(wLst, owner)
wObj.Delete
Copied(0).Delete
End Sub
The following is a code segment similar to the Wall Import,
but this one is generically defined allowing it to be used with any style
contained within the drawing
Sub ImportStyleFrom(FromDwg As AcadDocument, ToDwg As AcadDocument, ByVal tName As String, ByVal sName As String)
Dim obj As AcadObject, owner As AcadModelSpace, Lst(0) As AcadObject, Copied
Set obj = FromDwg.ModelSpace.AddCustomObject(tName)
obj.StyleName = sName
Set Lst(0) = obj
Set owner = ToDwg.ModelSpace
ToDwg.Utility.Prompt vbCrLf & "Importing style <" & sName & ">..."
Copied = FromDwg.CopyObjects(Lst, owner)
obj.Delete
Copied(0).Delete
End Sub
| 
