不录码，VBA语言实现MS台体绘制

Function 梯形拉伸成体(shapePoints() As Point3d, forwardLen As Double, backwardLen As Double) As Long
    Dim base As ShapeElement
    
    Set base = Application.CreateShapeElement1(Nothing, shapePoints)
   ' ActiveModelReference.AddElement base
    Dim ConeSurface1 As SmartSolidElement
    Dim ConeSurface2(0) As SmartSolidElement
    Dim tempE As ElementEnumerator
    'true 为体 false 为面，向前为正，向后为负，但向前向后不能同时进行取forwordLen与backwardLen之和决定向前还是向后
    Set ConeSurface1 = SmartSolid.ExtrudeClosedPlanarCurve(base, forwardLen, 0, True)
   ' ActiveModelReference.AddElement ConeSurface1
    
    Set ConeSurface2(0) = SmartSolid.ExtrudeClosedPlanarCurve(base, 0, -backwardLen, True)
    'ActiveModelReference.AddElement ConeSurface2(0)
    
    Set tempE = SmartSolid.BooleanDisjoint(ConeSurface1, ConeSurface2, 0)
  
    While tempE.MoveNext
        ActiveModelReference.AddElement tempE.Current
        梯形拉伸成体 = tempE.Current.ID.Low
    Wend
End Function

'合并两实体SmartSolid.BooleanDisjoint(主实体, 需要合并的实体数组, 并集＝0 交集＝1 差集＝2)
Function TestBooleanDisjoint(idOne As Long, idTwo As Long)
    Dim mySolid As SmartSolidElement
    Dim solidArray(0) As SmartSolidElement
    Dim ee As ElementEnumerator
    Debug.Print "idOne" & idOne & Chr(10) & "idTwo" & idTwo
    Set mySolid = ActiveModelReference.GetElementByID(DLongFromLong(idOne))
    Set solidArray(0) = ActiveModelReference.GetElementByID(DLongFromLong(idTwo))
    Set ee = SmartSolid.BooleanDisjoint(mySolid, solidArray, 1) ' 并集＝0 交集＝1 差集＝2
    While ee.MoveNext
        ActiveModelReference.AddElement ee.Current
    Wend
End Function
Function 正交台体(放置点 As Point3d, ByVal 底面长 As Double, ByVal 底面宽 As Double, ByVal 高 As Double, ByVal 顶面长 As Double, ByVal 顶面宽 As Double)
    Dim 梯形点集合(4) As Point3d
    Dim upNum As Long
    Dim rightNum As Long
    Dim ee As Element
    
    梯形点集合(0) = Point3dFromXYZ(放置点.x + 底面长 / 2, 放置点.Y, 放置点.Z)
    梯形点集合(1) = Point3dFromXYZ(放置点.x - 底面长 / 2, 放置点.Y, 放置点.Z)
    梯形点集合(2) = Point3dFromXYZ(放置点.x - 顶面长 / 2, 放置点.Y, 放置点.Z + 高)
    梯形点集合(3) = Point3dFromXYZ(放置点.x + 顶面长 / 2, 放置点.Y, 放置点.Z + 高)
    梯形点集合(4) = Point3dFromXYZ(放置点.x + 底面长 / 2, 放置点.Y, 放置点.Z)
    If 顶面宽 > 底面宽 Then
        upNum = 梯形拉伸成体(梯形点集合, 顶面宽 / 2 + 1, (顶面宽 / 2))
    Else
        upNum = 梯形拉伸成体(梯形点集合, 底面宽 / 2 + 1, (底面宽 / 2))
    End If
    梯形点集合(0) = Point3dFromXYZ(放置点.x, 放置点.Y + 底面宽 / 2, 放置点.Z)
    梯形点集合(1) = Point3dFromXYZ(放置点.x, 放置点.Y - 底面宽 / 2, 放置点.Z)
    梯形点集合(2) = Point3dFromXYZ(放置点.x, 放置点.Y - 顶面宽 / 2, 放置点.Z + 高)
    梯形点集合(3) = Point3dFromXYZ(放置点.x, 放置点.Y + 顶面宽 / 2, 放置点.Z + 高)
    梯形点集合(4) = Point3dFromXYZ(放置点.x, 放置点.Y + 底面宽 / 2, 放置点.Z)
    If 顶面长 > 底面长 Then
        rightNum = 梯形拉伸成体(梯形点集合, (顶面长 / 2 + 1), (顶面长 / 2))
    Else
        rightNum = 梯形拉伸成体(梯形点集合, (顶面长 / 2 + 1), (底面长 / 2))
    End If
    
    TestBooleanDisjoint upNum, rightNum
    Set ee = ActiveModelReference.GetElementByID(DLongFromLong(upNum))
    ActiveModelReference.RemoveElement ee
    Set ee = ActiveModelReference.GetElementByID(DLongFromLong(rightNum))
    ActiveModelReference.RemoveElement ee
End Function
Sub test()
    Dim tem As Point3d
    tem = Point3dFromXYZ(0, 0, 500)
    正交台体 tem, 100, 100, 100, 100, 100
End Sub