[求助]：vb获取cad 的面域的信息

karl_chan

请问如何用vb获取cad 的面域的的各种特性..谢谢了

雪山飞狐(lzh)

面域，由线、圆、弧、椭圆弧及样条曲线组成的带边界平面。

VBA 类名:
AcadRegion

创建方法:
ModelSpace.AddRegion
PaperSpace.AddRegion
Block.AddRegion

访问途径:
ModelSpace.Item
PaperSpace.Item
Block.Item
SelectionSet.Item
Group.Item


在面域中的每一对象保留着其图层、线型和颜色。AutoCAD 在将它们转换为面域后删除了原始对象，默认情况下面域不填充。

用户可用 Explode 方法分解面域为单独的边界。 Boolean 方法允许用户将实体或面域与其它实体或面域进行交集、并集和差集来创建复合的三维实体或面域。

要创建面域，可使用 AddRegion 方法。要编辑或查询面域，可使用以下方法和属性： 方法

ArrayPolar

ArrayRectangular

Boolean[布尔值]

Copy

Delete

Explode

GetBoundingBox

GetExtensionDictionary

GetXData

Highlight

IntersectWith

Mirror

Mirror3D

Move

Rotate

Rotate3D

ScaleEntity

SetXData

TransformBy

Update
属性

Application

Area

Centroid

Document

Handle

HasExtensionDictionary

Hyperlinks

Layer

Linetype

LinetypeScale

Lineweight

MomentOfInertia

Normal

ObjectID

ObjectName

OwnerID

Perimeter

PlotStyleName

PrincipalDirections

PrincipalMoments

ProductOfInertia

RadiiOfGyration

TrueColor

Visible
事件

Modified

karl_chan

经下为我用VB写的程序

Private Sub Command1_Click()   '调用CAD，所有调用CAD，都必须用它
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
   Err.Clear
   Set acadApp = CreateObject("AutoCAD.Application")
   If Err Then
      MsgBox Err.Description
      Exit Sub
   End If
End If
acadApp.Visible = True
Set Preference = acadApp.Preference
Set acaddoc = acadApp.ActiveDocument
Set MoSpace = acaddoc.ModelSpace
Set Paspace = acaddoc.PaperSpace
End Sub


Private Sub Command2_Click()
Dim I As Integer

For I = 0 To MoSpace.Count - 1
If MoSpace(I).EntityType = AcadRegion Then
      MsgBox "acregion was selected!!"
      End If
      Next I
End Sub
运行后出现"AcadRegion"变量没有定义的错误.请问如何解决?
在线守候!!!!!

雪山飞狐(lzh)

If MoSpace(I).objectname = "AcadRegion" Then

karl_chan

Option Explicit
Dim acadApp As Object
Dim Preference As Object
Dim acaddoc As Object
Dim Paspace As Object
Dim MoSpace As Object

Private Sub Command1_Click()
On Error Resume Next
Set acadApp = GetObject(, "AutoCAD.Application")
If Err Then
   Err.Clear
   Set acadApp = CreateObject("AutoCAD.Application")
   If Err Then
      MsgBox Err.Description
      Exit Sub
   End If
End If
acadApp.Visible = True
Set Preference = acadApp.Preference
Set acaddoc = acadApp.ActiveDocument
Set MoSpace = acaddoc.ModelSpace
Set Paspace = acaddoc.PaperSpace


Dim I As Integer

For I = 0 To MoSpace.Count - 1
If MoSpace(I).ObjectName = "AcadRegion" Then
      MsgBox "acregion was selected!!"
      End If
      Next I
End Sub

我在cad 中选中了一个然后点command1,,为什么没出现msgbox提示

版主能不能帮我修改一下这些代码.使得我在cad中选中一个面域后,
点 command1.  text控件的内容等于该面域的面积??????谢谢!!!!