请教斑主及各位大虾与面域有关的问题

ywy6688

斑主及大虾们:

  本人对VBA+CAD只知皮毛,   附图中的AB两个问题能解决吗?,怎么解决??

  求求各位了,国庆长假我作东

songzhi

Sub getArea()

    Dim objEnts()                   As AcadEntity
    Dim objEnt                      As AcadEntity
    Dim ssSet                       As AcadSelectionSet
    Dim iCount                      As Long
    Dim lngCount                    As Long
    Dim objRegion1                  As Variant
    Dim objRegion                   As AcadRegion

    lngCount = ThisDrawing.SelectionSets.Count
    If lngCount > 0 Then
        For iCount = lngCount - 1 To 0 Step -1
            Set ssSet = ThisDrawing.SelectionSets(iCount)
            If ssSet.Name = "SSSS" Then ssSet.Delete
        Next
    End If

    Set ssSet = ThisDrawing.SelectionSets.Add("SSSS")

    ssSet.SelectOnScreen
   
    lngCount = ssSet.Count
   
    If lngCount > 0 Then
        ReDim objEnts(0 To lngCount - 1)
        For iCount = 0 To lngCount - 1
            Set objEnts(iCount) = ssSet(iCount)
        Next
    End If
   
    objRegion1 = ThisDrawing.ModelSpace.AddRegion(objEnts)
    For iCount = LBound(objRegion1) To UBound(objRegion1)
        Set objRegion = objRegion1(iCount)
        'dblArea1 = dblArea1 + objRegion.Area

        MsgBox Cstr(objRegion.Area)
    Next
    ssSet.Delete
   
    Set objEnt = Nothing
    Set ssSet = Nothing
    Set objRegion = Nothing
   
End Sub

songzhi

问题B也是比较简单的，既然你有各点的坐标，先把圆弧也当成直线加入到轻量多段线中去，然后设置它的凸度就可以了。凸度计算公式是2*H/D,D为弦长，H为圆弧顶点到弦的距离。逆时针取正值，顺时针取负值。

以下代码画一段轻量多段线，第二段为圆弧：

Sub test()

    Dim oLSP    As AcadLWPolyline
    Dim p(0 To 7) As Double
   
    p(0) = 0#: p(1) = 0#
    p(2) = 100#: p(3) = 0#
    p(4) = 100#: p(5) = 100#
    p(6) = 0#: p(7) = 100#
   
    Set oLSP = ThisDrawing.ModelSpace.AddLightWeightPolyline(p)
   
    oLSP.SetBulge 1, 1
   
    Set oLSP = Nothing

   
End Sub

ywy6688

非常感谢songzhi 第二个问题已解决.

第一个问题通过屏幕选择相关的对象后,运行到

 objRegion1 = cad2.ModelSpace.AddRegion(objEnts) 这句时出现错误:

实时错误'-2147418113(8000ffff)':

对象'Addregion' 的方法IAcadModeSpace'失败

还望赐教

songzhi

上面的代码我是在ACAD2004 的VBA环境下测试的,没有在VB下试过。你说的问题我搜索了一下网上的相关资料。据资料介绍你可以编译后再试试看!

小美菜

用 ThisDrawing.SendCommand Chr(3) & Chr(3) & "-boundary" & vbCr & basePMN(0) & "," & basePMN(1) & vbCr & vbCr

可以自动生成一闭合多义线，即可求面积！