求助 面域布尔运算 赋值时报错 ——类型不匹配
本帖最后由 xueliang123 于 2015-1-20 13:46 编辑Public Sub createcage()
Dim dbpoint As Variant
Dim halfwidth As Double
Dim Hlength As Double
Hlength = 110
Dim outframpoint(0 To 7) As Double
Dim inframpoint(0 To 7) As Double
Dim cagecenter(0 To 2) As Double
Dim cageradius As Double
halfwidth = 255
cageradius = 350
Dim incircle(0 To 0) As AcadCircle
Dim outcircle(0 To 0) As AcadCircle
Dim outfram(0 To 0) As AcadEntity
Dim infram(0 To 0) As AcadEntity
'用户获取点并赋值以方便以后使用
dbpoint = ThisDrawing.Utility.GetPoint(, "Select a point")
cagecenter(0) = dbpoint(0) + 355: cagecenter(1) = dbpoint(1): cagecenter(2) = dbpoint(2)
With ThisDrawing.ModelSpace
Set incircle(0) = .AddCircle(cagecenter, cageradius)
Set outcircle(0) = .AddCircle(cagecenter, cageradius + 5)
'画外框
outframpoint(0) = dbpoint(0): outframpoint(1) = dbpoint(1) + halfwidth
outframpoint(2) = dbpoint(0) + Hlength: outframpoint(3) = dbpoint(1) + halfwidth
outframpoint(4) = dbpoint(0) + Hlength: outframpoint(5) = dbpoint(1) - halfwidth
outframpoint(6) = dbpoint(0): outframpoint(7) = dbpoint(1) - halfwidth
Set outfram(0) = .AddLightWeightPolyline(outframpoint)
outfram(0).Closed = True
'画内框
inframpoint(0) = dbpoint(0): inframpoint(1) = dbpoint(1) + halfwidth - 5
inframpoint(2) = dbpoint(0) + Hlength: inframpoint(3) = dbpoint(1) + halfwidth - 5
inframpoint(4) = dbpoint(0) + Hlength: inframpoint(5) = dbpoint(1) - halfwidth + 5
inframpoint(6) = dbpoint(0): inframpoint(7) = dbpoint(1) - halfwidth + 5
Set infram(0) = .AddLightWeightPolyline(inframpoint)
infram(0).Closed = True
'面域图形到
Dim regions(0 To 3) As Variant
regions(0) = .AddRegion(outcircle):regions(1) = .AddRegion(incircle)
regions(2) = .AddRegion(outfram):regions(3) = .AddRegion(infram)
'将面域复制
Dim A, B, C, D As AcadRegion
Set A = regions(0): Set B = regions(1): Set C = regions(2): Set D = regions(3)
A.Boolean acSubtraction, B: C.Boolean acSubtraction, D
End With
End Sub
将47,50 ,51 加引号注释就运行很好 ,求高手帮忙看看 这个却运行的很好,不知道上面那个程序是哪里错了Sub Ch4_CreateCompositeRegions()
' 创建两个圆,一个代表房间,
' 另外一个为房间中心的柱子
Dim RoomObjects(0 To 1) As AcadCircle
Dim center(0 To 2) As Double
Dim radius As Double
center(0) = 4
center(1) = 4
center(2) = 0
radius = 2#
Set RoomObjects(0) = ThisDrawing.ModelSpace.AddCircle(center, radius)
radius = 1#
Set RoomObjects(1) = ThisDrawing.ModelSpace.AddCircle(center, radius)
' 用两个圆创建面域
Dim regions As Variant
regions = ThisDrawing.ModelSpace.AddRegion(RoomObjects)
' 将面域复制到面域变体中以方便使用
Dim RoundRoomObj As AcadRegion
Dim PillarObj As AcadRegion
If regions(0).Area > regions(1).Area Then
' 第一个面域为房间
Set RoundRoomObj = regions(0)
Set PillarObj = regions(1)
Else
' 第一个面域为柱子
Set PillarObj = regions(0)
Set RoundRoomObj = regions(1)
End If
' 将房间颜色设为红色,柱子颜色设为青色
RoundRoomObj.color = acRed
PillarObj.color = acCyan
ZoomAll
' 从地板空间中减去柱子的空间
' 以得到代表总的地毯面积的面域。
RoundRoomObj.Boolean acSubtraction, PillarObj
' 使用Area属性以确定总的地毯面积
MsgBox "地毯面积为: " & RoundRoomObj.Area
End Sub D:\Capture.JPG 程序运行附图 AddRegion返回的是数组/variant
不是数组的成员!!!!
regions(0) = .AddRegion(outcircle) 这当然不对了!
还有Dim A, B, C, D As AcadRegion,把ABC也定义成AcadRegion,而不应该是variant
页:
[1]