'将Solid实体转换成图案填充
Sub Solid2Hatch()
    Dim Obj As Object
    Dim SSet As AcadSelectionSet
    'On Error Resume Next
    Set SSet = CreateSelectionSet("XXX")
    '定义过滤机制
    Dim filterType(0) As Integer
    Dim filterData(0) As Variant
    filterType(0) = 0
    filterData(0) = "Solid"
    SSet.SelectOnScreen filterType, filterData
    '对选择集中的对象进行操作
    Dim PS As Variant
    Dim PL As AcadLWPolyline
    Dim P2() As Double
    For Each Obj In SSet
        PS = Obj.Coordinates
        ReDim P2(7)
        P3ToP2_2 PS, P2
        Set PL = ThisDrawing.ModelSpace.AddLightWeightPolyline(P2)
        PL.color = acRed
        PL.Closed = True
        TC PL
        Obj.Delete
    Next
End Sub
'3D坐标组，转换成2D坐标组
'solid 四个顶点中的第三个和第四个交换
Function P3ToP2_2(P3 As Variant, ByRef P2() As Double)
    Dim i As Long
    i = UBound(P2)
    Dim j As Long
    For j = 0 To i Step 2
        P2(j) = P3(j / 2 * 3)
        P2(j + 1) = P3(j / 2 * 3 + 1)
    Next j
    Dim temp1 As Double, temp2 As Double
    temp1 = P2(6): temp2 = P2(7)
    P2(6) = P2(4): P2(7) = P2(5)
    P2(4) = temp1: P2(5) = temp2
End Function
'3D坐标组，转换成2D坐标组
Function P3ToP2(P3 As Variant, ByRef P2() As Double)
    Dim i As Long
    i = UBound(P2)
    Dim j As Long
    For j = 0 To i Step 2
        P2(j) = P3(j / 2 * 3)
        P2(j + 1) = P3(j / 2 * 3 + 1)
    Next j
End Function