Bingo940 发表于 2019-9-12 09:27:59

cass获取界址线每条线段属性

代码如下,运行结果显示每段线的属性都为空值,但用cass导出属性,有属性数据,有起点号和终点号等属性,求高手解答!!!

Sub test4()
    On Error Resume Next

    Dim obj As AcadEntity, pnt, oVers
    Dim xt, xd
    Dim i As Integer
    Dim s As String, j As Integer
    ThisDrawing.Utility.GetEntity obj, pnt, "请选择界址线所在的宗地:"
    oVers = GetVertexs(obj)
    If oVers <> vbEmpty Then
      For i = 0 To UBound(oVers)
            s = ""
            Call oVers(i).GetXData("", xt, xd)
            Debug.Print UBound(xd)
            For j = 0 To UBound(xd)
                s = s & vbCrLf & xd(j)
            Next j
            If Err Then
                Err.Clear
                MsgBox "空值"
            Else
                MsgBox s
            End If
      Next i
    Else
      MsgBox "错误选择"
    End If
End Sub
Function GetVertexs(Ent As AcadEntity) As Variant
    Dim n As Integer
    Dim oVertexs() As AcadObject
    Dim sName As String
    sName = UCase(Ent.ObjectName)
    Dim lst
    Dim i As Integer

   Debug.Print sName & "aaa" & UBound(Ent.Coordinates)


    If sName = "ACDB2DPOLYLINE" Or sName = "ACDB3DPOLYLINE" Then
      n = (UBound(Ent.Coordinates) + 1) / 3
    End If
   Debug.Print n
    If n = 0 Then Exit Function

    ReDim oVertexs(n - 1)

    Dim oVlax As New VLAX
    lst = oVlax.GetLispList("(GetVers """ & Ent.Handle & """)")
    Debug.Print Ent.Handle
    For i = 1 To n
      Set oVertexs(i - 1) = ThisDrawing.HandleToObject(lst(n - i))
      Debug.Print oVertexs(i - 1).Handle
    Next i

    GetVertexs = oVertexs

End Function


页: [1]
查看完整版本: cass获取界址线每条线段属性