从分解的块中挤出区域

Public Sub DrawWideFlangeSteel()
      Dim oCyl As Acad3DSolid, oCircle As AcadCircle, oLine As AcadLine, oLayer As AcadLayer
      Dim oBeam As Acad3DSolid, oReg As AcadRegion, oBlock As AcadBlockReference, oObject As AcadObject
      Dim varpick As Variant
      Dim Ent As AcadEntity
      Dim Inspt As Variant
      Dim RegEnt(0) As AcadEntity
      Dim V(2) As Double, Unit As Double, Vn(2) As Double, dblBusDia As Double
      Dim P1, P2
      Dim newPT1 As Variant
      Dim newPT2 As Variant
      Set oLayer = ThisDrawing.Layers.Add("3D-BUSS-STEEL")
      oLayer.color = 235
      
      Inspt = ThisDrawing.Utility.GetPoint(, "Pick Insertion Point: ")
      If ThisDrawing.ActiveSpace = acModelSpace Then
      Set oBlock = ThisDrawing.ModelSpace.InsertBlock(Inspt, "M:\MODEL-COMPONENTS\w8x24.dwg", 1#, 1#, 1#, 0)
      Else
      Set oBlock = ThisDrawing.PaperSpace.InsertBlock(Inspt, "M:\MODEL-COMPONENTS\w8x24.dwg", 1#, 1#, 1#, 0)
      End If
      ThisDrawing.Regen acActiveViewport
Set oObject = oBlock.Explode
'      ThisDrawing.Utility.GetEntity Ent, varpick
'      If Not TypeOf Ent Is AcadLine Then
'            MsgBox "That was not a Layout Line"
'            Exit Sub
'      End If
'      Set oLine = Ent
'      newPT1 = oLine.StartPoint
'      newPT2 = oLine.EndPoint
'      newPT1(2) = ConvertFeet(frmInsPart.cboBusHeight.Value)
'      newPT2(2) = ConvertFeet(frmInsPart.cboBusHeight.Value)
'      Set oLine = ThisDrawing.ModelSpace.AddLine(newPT1, newPT2)
'      oLine.Layer = "3D-BUSS-CALC"
'      P1 = oLine.StartPoint: P2 = oLine.EndPoint
'      V(0) = P2(0) - P1(0): V(1) = P2(1) - P1(1): V(2) = P2(2) - P1(2)
      'Normalise the vector(It's length=1)
'      Unit = Sqr(V(0) * V(0) + V(1) * V(1) + V(2) * V(2))
'      Vn(0) = V(0) / Unit: Vn(1) = V(1) / Unit: Vn(2) = V(2) / Unit
'      dblBusDia = CDbl(frmInsPart.cboBusSize.Value + 0.5) / 2
'      Set oCircle = ThisDrawing.ModelSpace.AddCircle(oLine.StartPoint, dblBusDia)
      ThisDrawing.Regen acActiveViewport
'      oCircle.Normal = Vn    ' Vn or V both work here.
'      ThisDrawing.Regen acActiveViewport
'      Set RegEnt(0) = oCircle
'      oReg = ThisDrawing.ModelSpace.AddRegion(RegEnt)
'      Set oCyl = ThisDrawing.ModelSpace.AddExtrudedSolid(oReg(0), oLine.Length, 0)
'      oCircle.Delete
'      oReg(0).Delete
End Sub