'**********************************************************************************************

'繪制圓臺(tái)***********************************************繪制圓臺(tái)*********************************
'    PA------A1-------PB
'     |                   |
'     B1                B1
'     |                   |
'    PC------A1-------PD
'

Sub DrawLT()
    Dim A1 As Double, B1 As Double, A2 As Double, B2 As Double, H As Double
    On Error GoTo ex:
    '輸入棱臺(tái)的尺寸
    ThisDrawing.Utility.InitializeUserInput 1, ""
    A1 = ThisDrawing.Utility.GetReal("棱臺(tái)底面長(zhǎng)(A1):")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    B1 = ThisDrawing.Utility.GetReal("棱臺(tái)底面寬(B1):")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    A2 = ThisDrawing.Utility.GetReal("棱臺(tái)頂面長(zhǎng)(A2):")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    B2 = ThisDrawing.Utility.GetReal("棱臺(tái)頂面寬(B2):")
    ThisDrawing.Utility.InitializeUserInput 1, ""
    H = ThisDrawing.Utility.GetReal("棱臺(tái)高(H):")
    Dim PO As Variant
    ThisDrawing.Utility.InitializeUserInput 1, ""
    PO = ThisDrawing.Utility.GetPoint(, "指定基點(diǎn):  ")

    '計(jì)算棱臺(tái)的八個(gè)角點(diǎn)的坐標(biāo)
    Dim PA(2) As Double, PB(2) As Double, PC(2) As Double, PD(2) As Double
    Dim PE(2) As Double, PF(2) As Double, PG(2) As Double, PH(2) As Double
    PA(0) = 0 + PO(0):    PA(1) = 0 + PO(1):     PA(2) = 0 + PO(2)
    PB(0) = A1 + PO(0):   PB(1) = 0 + PO(1):     PB(2) = 0 + PO(2)
    PC(0) = 0 + PO(0):    PC(1) = 0 + PO(1):     PC(2) = B1 + PO(2)
    PD(0) = A1 + PO(0):   PD(1) = 0 + PO(1):     PD(2) = B1 + PO(2)
    PE(0) = (A1 - A2) / 2 + PO(0):      PE(1) = H + PO(1):    PE(2) = (B1 - B2) / 2 + PO(2)
    PF(0) = (A1 - A2) / 2 + A2 + PO(0): PF(1) = H + PO(1):    PF(2) = (B1 - B2) / 2 + PO(2)
    PG(0) = (A1 - A2) / 2 + PO(0):      PG(1) = H + PO(1):    PG(2) = (B1 - B2) / 2 + B2 + PO(2)
    PH(0) = (A1 - A2) / 2 + A2 + PO(0): PH(1) = H + PO(1):    PH(2) = (B1 - B2) / 2 + B2 + PO(2)

    ' ThisDrawing.ModelSpace.AddPoint PA
    ' ThisDrawing.ModelSpace.AddPoint PB
    ' ThisDrawing.ModelSpace.AddPoint PC
    ' ThisDrawing.ModelSpace.AddPoint PD
    ' ThisDrawing.ModelSpace.AddPoint PE
    ' ThisDrawing.ModelSpace.AddPoint PF
    ' ThisDrawing.ModelSpace.AddPoint PG
    ' ThisDrawing.ModelSpace.AddPoint PH
    '找出五個(gè)尺寸中最大的一個(gè),用來(lái)繪制正方體
    Dim Max As Double
    Max = 0
    If A1 > Max Then Max = A1
    If B1 > Max Then Max = B1
    If A2 > Max Then Max = A2
    If B2 > Max Then Max = B2
    If H > Max Then Max = H

    '繪制的正方體中心
    Dim PO_1(2) As Double
    PO_1(0) = PO(0) + A1 / 2: PO_1(1) = PO(1) + H / 2: PO_1(2) = PO(2) + B1 / 2
    '繪制正方體，之所以繪制出個(gè)最大尺寸的正方，而不是長(zhǎng)方體。是因?yàn)閃PS和UPS坐標(biāo)的問(wèn)題，容易出現(xiàn)棱臺(tái)的八個(gè)點(diǎn)不在長(zhǎng)方體內(nèi)。
    Dim xRecTangle As Acad3DSolid
    Set xRecTangle = ThisDrawing.ModelSpace.AddBox(PO_1, Max, Max, Max)
    '按照的八個(gè)頂點(diǎn)做成的六個(gè)面分別剖切正方體，從而生成一個(gè)棱臺(tái)。
    Dim SliceObj1 As Acad3DSolid, SliceObj2 As Acad3DSolid ', SliceObj3 As Acad3DSolid, SliceObj4 As Acad3DSolid
    Set SliceObj1 = xRecTangle.SliceSolid(PA, PB, PE, True)
    xRecTangle.Delete
    Set SliceObj2 = SliceObj1.SliceSolid(PA, PC, PE, True)
    SliceObj2.Delete
    Set SliceObj2 = SliceObj1.SliceSolid(PC, PD, PH, True)
    SliceObj2.Delete
    Set SliceObj2 = SliceObj1.SliceSolid(PB, PD, PH, True)
    SliceObj1.Delete
    Set SliceObj1 = SliceObj2.SliceSolid(PA, PB, PC, True)
    SliceObj1.Delete
    Set SliceObj1 = SliceObj2.SliceSolid(PE, PF, PG, True)
    SliceObj2.Delete
    Exit Sub
ex:
    ThisDrawing.Utility.Prompt Err.Description
    Err.Clear
    Exit Sub
End Sub