View Full Version : AUTOCAD 2006--unable to extrude in vba

05-16-2006, 03:56 AM
i'm trying to automate the process of making a 3d object in autocad 2006 by using vba.
actually i'm a newbie and have tried my hand at writing the following code but unsuccessfully.the problem is i'm unable to extrude a closed polyline.maybe i'm making a mistake somewhere.can ne one tell me whats wrong in the following code??

Public Sub Mymacro()
Dim Centre(0 To 2) As Double
Dim varRadius As Variant
Dim objEnt(0 To 1) As AcadEntity
Dim P(0 To 11) As Double
Dim P1(0 To 2) As Double
Dim P2(0 To 2) As Double
Dim P3(0 To 2) As Double
Dim P4(0 To 2) As Double
Dim P5(0 To 2) As Double
Dim P6(0 To 2) As Double
Dim Length As Variant
Dim Breadth As Variant
Dim dblAngletoFill As Variant
Dim lngNumberofObjects As Variant
Dim varPolarArray As Variant
Dim dblHeight As Double
Dim objShape As Acad3DSolid
Dim mI As Integer
Centre(0) = 0: Centre(1) = 0: Centre(2) = 0
With ThisDrawing.Utility
varRadius = .GetDistance(Centre, vbCr & "Radius of the circular column:")
End With
P1(0) = varRadius: P1(1) = 0: P1(2) = 0
Set objEnt(0) = ThisDrawing.ModelSpace.AddCircle(Centre, varRadius)

With ThisDrawing.Utility
Length = .GetDistance(, "Length of rectangle:")
Breadth = .GetDistance(, "Breadth of rectangle:")
P3(0) = P1(0) + Length: P3(1) = P1(1) - Breadth: P3(2) = 0
P2(0) = P1(0) + Length: P2(1) = 0: P2(2) = 0
P4(0) = P1(0): P4(1) = P1(1) - Breadth: P4(2) = 0
P5(0) = P1(0): P5(1) = P1(1) - (Breadth / 2): P5(2) = 0
P6(0) = ((varRadius) ^ 2 - (Breadth / 2) ^ 2) ^ 0.5: P6(1) = 0: P6(2) = 0
End With
P(0) = P1(0): P(1) = P1(1): P(2) = P1(2)
P(3) = P2(0): P(4) = P2(1): P(5) = P2(2)
P(6) = P3(0): P(7) = P3(1): P(8) = P3(2)
P(9) = P4(0): P(10) = P4(1): P(11) = P4(2)
Set objEnt(1) = ThisDrawing.ModelSpace.AddPolyline(P)
objEnt(1).Closed = True
objEnt(1).Move P5, P6
lngNumberofObjects = ThisDrawing.Utility.GetInteger( _
"Enter total number of objects required in the array: ")
dblAngletoFill = ThisDrawing.Utility.GetReal( _
"Enter an angle (in degrees less than 360) over which the array shouldextend: ")
dblAngletoFill = ThisDrawing.Utility.AngleToReal _
(CStr(dblAngletoFill), acDegrees)
varPolarArray = objEnt(1).ArrayPolar(lngNumberofObjects, _
dblAngletoFill, Centre)

dblHeight = ThisDrawing.Utility.GetDistance(Centre, vbCr & _
"Enter the extrusion height: ")
For mI = 0 to UBound(varPolarArray)
Set objShape = ThisDrawing.ModelSpace.AddExtrudedSolid(varPolarArray(mI), dblHeight, 0)
End Sub

EDIT: Added VBA tabgs - Tommy

07-01-2006, 03:35 PM
Hi pondy and welcome :hi:

I'm having trouble with your varPolarArray. You stated to put the value in degrees but I was reading the Developer help file and the angle to fill piece is supposed to be in radians (when using the ArrayPolar method) and cannot be 0 (you should note that in the prompt).

After the varPolarArray problem, I got to the For Next loop problem. Apparently the AddExtrudeSolid method needs an AcadRegion in the first arguement, which you put a variant there. I'm not sure entirely how to fix it, though.

BTW I'm a newbie at AutoCAD vba (especially with 3d), so bear with me.

I would take a look at the following code to better guide you, it's from the help file:

Sub Example_AddExtrudedSolid()
' This example extrudes a solid from a region.
' The region is created from an arc and a line.

Dim curves(0 To 1) As AcadEntity

' Define the arc
Dim centerPoint(0 To 2) As Double
Dim radius As Double
Dim startAngle As Double
Dim endAngle As Double
centerPoint(0) = 5#: centerPoint(1) = 3#: centerPoint(2) = 0#
radius = 2#
startAngle = 0
endAngle = 3.141592
Set curves(0) = ThisDrawing.ModelSpace.AddArc(centerPoint, radius, startAngle, endAngle)

' Define the line
Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).StartPoint, curves(0).EndPoint)

' Create the region
Dim regionObj As Variant
regionObj = ThisDrawing.ModelSpace.AddRegion(curves)

' Define the extrusion
Dim height As Double
Dim taperAngle As Double
height = 3
taperAngle = 0

' Create the solid
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolid(regionObj(0), height, taperAngle)

' Change the viewing direction of the viewport
Dim NewDirection(0 To 2) As Double
NewDirection(0) = -1: NewDirection(1) = -1: NewDirection(2) = 1
ThisDrawing.ActiveViewport.Direction = NewDirection
ThisDrawing.ActiveViewport = ThisDrawing.ActiveViewport

End Sub

Hope this helps (I know it's been over a month since this post. But I thought I should try :thumb)