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