It's difficult to follow your example. Take a look at this from page 173 of
my original book.
Public Sub TestAddExtrudedSolid()
Dim varCenter As Variant
Dim dblRadius As Double
Dim dblHeight As Double
Dim dblTaper As Double
Dim strInput As String
Dim varRegions As Variant
Dim objEnts() As AcadEntity
Dim objEnt As Acad3DSolid
Dim varItem As Variant
On Error GoTo Done
'' get input from user
With ThisDrawing.Utility
.InitializeUserInput 1
varCenter = .GetPoint(, vbCr & "Pick the center point: ")
.InitializeUserInput 1 + 2 + 4
dblRadius = .GetDistance(varCenter, vbCr & "Indicate the radius: ")
.InitializeUserInput 1 + 2 + 4
dblHeight = .GetDistance(varCenter, vbCr & _
"Enter the extrusion height: ")
'' get the taper type
.InitializeUserInput 1, "Expand Contract None"
strInput = .GetKeyword(vbCr & _
"Extrusion taper [Expand/Contract/None]: ")
'' if none, taper = 0
If strInput = "None" Then
dblTaper = 0
'' otherwise, get the taper angle
Else
.InitializeUserInput 1 + 2 + 4
dblTaper = .GetReal("Enter the taper angle ( in degrees): ")
dblTaper = .AngleToReal(CStr(dblTaper), acDegrees)
'' if expanding, negate the angle
If strInput = "Expand" Then dblTaper = -dblTaper
End If
End With
'' draw the entities
With ThisDrawing.ModelSpace
'' draw the outer region (circle)
ReDim objEnts(0)
Set objEnts(0) = .AddCircle(varCenter, dblRadius)
'' create the region
varRegions = .AddRegion(objEnts)
'' extruded the solid
Set objEnt = .AddExtrudedSolid(varRegions(0), dblHeight, dblTaper)
'' update the extruded solid
objEnt.Update
End With
Done:
If Err Then MsgBox Err.Description
'' delete the temporary geometry
For Each varItem In objEnts
varItem.Delete
Next
For Each varItem In varRegions
varItem.Delete
Next
End Sub
Joe ...
"Adesu" wrote in message
news:5981265@discussion.autodesk.com...
I still attempt to extrude an object by get an entity object, but still
error
[code]
Sub tes()
Dim ObjEnt As AcadEntity
Dim Hei As Integer
Dim Tap As Integer
Dim ObjReg As Variant
Dim ObjExt As AcadSolid
ThisDrawing.Utility.GetEntity ObjEnt, "Pick an object region"
Set ObjReg = ThisDrawing.ModelSpace.AddRegion(ObjEnt)
Hei = ThisDrawing.Utility.GetInteger("Enter new height object: ")
Tap = 0
Set ObjExt = ThisDrawing.ModelSpace.AddExtrudedSolid(ObjReg, Hei, Tap)
End Sub
[/code]
