pondy

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)

Next

End Sub

EDIT: Added VBA tabgs - Tommy

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)

Next

End Sub

EDIT: Added VBA tabgs - Tommy