|
The Code
Function AddWall(sp As Variant, ep As Variant) As AecWall
Set AddWall = ThisDrawing.ModelSpace.AddCustomObject("AecWall")
AddWall.StartPoint = sp
AddWall.EndPoint = ep
End Function
Function AddWindow(ip As Variant) As AecWindow
Set AddWindow = ThisDrawing.ModelSpace.AddCustomObject("AecWindow")
AddWindow.Location = ip
End Function
Function AddDoor(ip As Variant) As AecDoor
Set AddDoor = ThisDrawing.ModelSpace.AddCustomObject("AecDoor")
AddDoor.Location = ip
End Function
Function AddWinAssem(ip As Variant) As AecWindowAssembly
Set AddWinAssem = ThisDrawing.ModelSpace.AddCustomObject("AecWindowAssembly")
AddWinAssem.Location = ip
End Function
Function AddOpening(ip As Variant) As AecOpening
Set AddOpening = ThisDrawing.ModelSpace.AddCustomObject("AecOpening")
AddOpening.Location = ip
End Function
Sub AttachDoorToWall(dr As AecDoor, wl As AecWall)
Dim wAnch As New AecAnchorOpeningBaseToWall
wAnch.Reference = wl
dr.AttachAnchor wAnch
End Sub
The following code is similar to the above Door code, but
has been modified to work with Doors, Windows, Openings, and Window Assemblies.
Sub AttachToWall(obj As AcadObject, wl As AecWall)
Dim wAnch As New AecAnchorOpeningBaseToWall, _
wi As AecWindow, dr As AecDoor, ws As AecWindowAssembly, op As AecOpening
wAnch.Reference = wl
Select Case typename(obj)
Case "IAecDoor"
Set dr = obj
dr.AttachAnchor wAnch
dr.Update
Case "IAecWindow"
Set wi = obj
wi.AttachAnchor wAnch
wi.Update
Case "IAecWindowAssembly"
Set ws = obj
Dim wsAnch As New AecAnchorWinAssemblyToWall
wsAnch.Reference = wl
ws.AttachAnchor wsAnch
ws.Update
Case "IAecOpening"
Set op = obj
op.AttachAnchor wAnch
op.Update
Case Else
End Select
End Sub
Function GetAlongPosition(obj As AcadObject) As AecCurvePosition
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
GetAlongPosition = anch.XPositionFrom
End Function
Function GetAlongDistance(obj As AcadObject) As Double
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
GetAlongDistance = anch.XDistance
End Function
Sub SetAlongPosition(obj As AcadObject, from As AecCurvePosition)
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
anch.XPositionFrom = from
End Sub
Sub SetAlongDistance(obj As AcadObject, dis As Double)
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
anch.XDistance = dis
End Sub
Function GetWithinDistance(obj As AcadObject) As Double
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
GetWithinDist = anch.YDistance
End Function
Sub SetWithinDistance(obj As AcadObject, dis As Double)
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
anch.YDistance = dis
End Sub
Function GetWithinPosition(obj As AcadObject) As AecCurveWidthPosition
Dim anch As AecAnchorOpeningBaseToWall
Set anch = dr.GetAnchor
GetWithinPosition = anch.YPositionFrom
End Function
Function SetWithinPosition(obj As AcadObject, from As AecCurveWidthPosition)
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
anch.YPositionFrom = from
End Function
Function GetHeightPosition(obj As AcadObject) As AecCurveHeightPosition
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
GetHeightPosition = anch.ZPositionFrom
End Function
Sub SetHeightPosition(obj As AcadObject, from As AecCurveHeightPosition)
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
anch.ZPositionFrom = from
End Sub
Function getHeightDistance(obj As AcadObject) As Double
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
getHeightDistance = anch.ZDistance
End Function
Sub SetHeightDistance(obj As AcadObject, dist As Double)
Dim anch As AecAnchorOpeningBaseToWall
Set anch = obj.GetAnchor
anch.ZDistance = dist
End Sub
| 
