(求助)为什么不支持质心属性

luckyliya

我编了一段程序,想求面积最大的面域的质心,代码如下:

Public Sub zx()
    Dim pt As Variant
    Dim spt1 As String
    Dim spt2 As String
    spt1 = 0 & "," & 0
    spt2 = 400 & "," & 400
    Dim n As Variant
    '创建面域
    Dim ssetobj As AcadSelectionSet
    Dim i As Integer
'清空选择集中已有的选择集,避免重名
  If ThisDrawing.SelectionSets.count > 0 Then
    For i = 0 To ThisDrawing.SelectionSets.count - 1
      ThisDrawing.SelectionSets.Item(i).Clear
      ThisDrawing.SelectionSets.Item(i).Delete
   Next
 End If
   ThisDrawing.SendCommand "region" & vbCr & spt1 & vbCr & spt2 & vbCr & vbCr
    Set ssetobj = ThisDrawing.SelectionSets.Add("ss")
   
    Dim FType(0) As Integer
    Dim FData(0) As Variant
    FType(0) = 0
    FData(0) = "region"
    Dim FilterType As Variant
    Dim FilterData As Variant
    FilterType = FType
    FilterData = FData
    ssetobj.Select acSelectionSetAll, , , FilterType, FilterData
    k = ssetobj.count
    MsgBox k

    Dim area As Double
    Dim maxarea As Double
    maxarea = 1
    Dim pregion As AcadRegion
    Dim centriod As Variant
   
    For i = 0 To ssetobj.count - 1
      area = ssetobj.Item(i).area
       If maxarea < area Then
       maxarea = area
       End If
    Next
   
   
    For i = 0 To ssetobj.count - 1
      If ssetobj.Item(i).area = maxarea Then
      centriod = ssetobj.Item(i).centriod
      End If
    Next
  
   MsgBox maxarea
   MsgBox centriod
  ssetobj.Delete
     
  End Sub

加红的一段代码中,把centriod 改成area或perimeter都可以,但改成centriod时,系统提示

"对象不支持该属性或方法"

为什么系统支持面积和周长属性,而不支持质心属性呢?

我是初学者,请各位高手帮帮忙?提提意见也好!

luckyliya

不好意思,其是的centriod 应改成centroid

luckyliya

调出来了,以下是可运行的代码:

 

Public Sub zx()
    Dim pt As Variant
    Dim spt1 As String
    Dim spt2 As String
    spt1 = 0 & "," & 0
    spt2 = 400 & "," & 400
    Dim n As Variant
    '创建面域
    Dim ssetobj As AcadSelectionSet
    Dim i As Integer
'清空选择集中已有的选择集,避免重名
  If ThisDrawing.SelectionSets.count > 0 Then
    For i = 0 To ThisDrawing.SelectionSets.count - 1
      ThisDrawing.SelectionSets.Item(i).Clear
      ThisDrawing.SelectionSets.Item(i).Delete
   Next
 End If
   ThisDrawing.SendCommand "region" & vbCr & spt1 & vbCr & spt2 & vbCr & vbCr
    Set ssetobj = ThisDrawing.SelectionSets.Add("ss")
   
    Dim FType(0) As Integer
    Dim FData(0) As Variant
    FType(0) = 0
    FData(0) = "region"
    Dim FilterType As Variant
    Dim FilterData As Variant
    FilterType = FType
    FilterData = FData
    ssetobj.Select acSelectionSetAll, , , FilterType, FilterData
    k = ssetobj.count
    MsgBox k

    Dim area As Double
    Dim maxarea As Double
    maxarea = 1
    Dim pregion As AcadRegion
    Dim centroid As Variant
    Dim x As Double
    Dim y As Double
   
    For i = 0 To ssetobj.count - 1
      area = ssetobj.Item(i).area
       If maxarea < area Then
       maxarea = area
       End If
    Next
   
   
    For i = 0 To ssetobj.count - 1
      If ssetobj.Item(i).area = maxarea Then
      centroid = ssetobj.Item(i).centroid
      x = centroid(0)
      y = centroid(1)
      End If
    Next
  
   MsgBox maxarea
   MsgBox (x & "," & y)
  ssetobj.Delete
     
  End Sub