[求助]关于创建面域的问题

南山樵夫

我需要在VB的程序界面打开一张图，图上已经有大量的图形元素，然后进入AutoCAD界面，用鼠标选取一个三角形（由三条直线构成的封闭的三角形），然后又重新进入VB界面，由VB程序将这个三角形创建一个面域，请问如何用程序来实现？最好给出实例。

mccad

你三条直线构成的三角形是否首尾相连的？

南山樵夫

三条直线是首尾相连的，三角形是封闭的。

mccad

以下程序只考虑你的要求，没有增加一些错误的判断，自己加吧：

2. Sub MakeRegion()
   
3.     Dim Ent(2) As AcadEntity
   
4.     Dim Pnt As Variant
   
5.     On Error Resume Next
   
6.     ThisDrawing.Utility.GetEntity Ent(0), Pnt, "选择第一条线："
   
7.     ThisDrawing.Utility.GetEntity Ent(1), Pnt, "选择第二条线："
   
8.     ThisDrawing.Utility.GetEntity Ent(2), Pnt, "选择第三条线："
   
9.     Dim Regs As Variant
   
10.     Regs = ThisDrawing.ModelSpace.AddRegion(Ent)
    
11.     If Err Then
    
12.         Err.Clear
    
13.         ThisDrawing.Utility.Prompt vbCrLf & "选定的对象不能生成面域"
    
14.     Else
    
15.         'Dim Reg As AcadRegion
    
16.         If IsArray(Regs) Then
    
17.             ThisDrawing.Utility.Prompt vbCrLf & "生成的面域数量：" & UBound(Regs) + 1
    
18.             'Set Reg = Regs(0)
    
19.             Ent(0).Delete: Ent(1).Delete: Ent(2).Delete
    
20.         Else
    
21.             ThisDrawing.Utility.Prompt vbCrLf & "选定的对象不能生成面域"
    
22.         End If
    
23.     End If
    
24. End Sub
    

Sub MakeRegion()<br />     Dim Ent(2) As AcadEntity<br />     Dim Pnt As Variant<br />     On Error Resume Next<br />     ThisDrawing.Utility.GetEntity Ent(0), Pnt, "选择第一条线："<br />     ThisDrawing.Utility.GetEntity Ent(1), Pnt, "选择第二条线："<br />     ThisDrawing.Utility.GetEntity Ent(2), Pnt, "选择第三条线："<br />     Dim Regs As Variant<br />     Regs = ThisDrawing.ModelSpace.AddRegion(Ent)<br />     If Err Then<br />         Err.Clear<br />         ThisDrawing.Utility.Prompt vbCrLf & "选定的对象不能生成面域"<br />     Else<br />         'Dim Reg As AcadRegion<br />         If IsArray(Regs) Then<br />             ThisDrawing.Utility.Prompt vbCrLf & "生成的面域数量：" & UBound(Regs) + 1<br />             'Set Reg = Regs(0)<br />             Ent(0).Delete: Ent(1).Delete: Ent(2).Delete<br />         Else<br />             ThisDrawing.Utility.Prompt vbCrLf & "选定的对象不能生成面域"<br />         End If<br />     End If<br /> End Sub<br />

南山樵夫