Consulting

Results 1 to 2 of 2

Thread: AUTOCAD 2006--unable to extrude in vba

  1. #1
    VBAX Newbie
    Joined
    May 2006
    Posts
    1
    Location

    AUTOCAD 2006--unable to extrude in vba

    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??

    [VBA] 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[/VBA]

    EDIT: Added VBA tabgs - Tommy

  2. #2
    Administrator
    2nd VP-Knowledge Base
    VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Hi pondy and welcome

    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:

    [VBA]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
    ZoomAll

    End Sub[/VBA]

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




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •