Joro-- Posted January 10, 2006 Share Posted January 10, 2006 Hi, can anybody help me with extruding along path with taper angle in VBA? Actually I am aware of the ExtrudeAlongPath method, but can I define a taper angle there? Any help will be appreciated... Quote Link to comment Share on other sites More sharing options...
hendie Posted January 10, 2006 Share Posted January 10, 2006 if you look at the AddExtrudedSolid topic in the Help file it gives you a complete example of creating an extruded solid ~ all you need to do is change the 0 degrees for whatever value you require Quote Link to comment Share on other sites More sharing options...
Joro-- Posted January 11, 2006 Author Share Posted January 11, 2006 Taper angle can surely be defined with the AddExtrudedSolid method. The problem is that I need extrusion along a path, which is a 2d polyline and gradual decrease of section of the extruded solid. That's why I need an extrudedSolidAlongPath. Actually if I do this manually in ACad I can define a taper angle there, just don't see such as option in VBA.... Quote Link to comment Share on other sites More sharing options...
hendie Posted January 11, 2006 Share Posted January 11, 2006 in autocad you can either extrude along a path, or extrude with a taper, you cannot do both Quote Link to comment Share on other sites More sharing options...
Joro-- Posted January 11, 2006 Author Share Posted January 11, 2006 In AutoCad it is possible to extrude along path with taper, but may be it is impossible to achieve in VBA... Quote Link to comment Share on other sites More sharing options...
Anna151 Posted September 6, 2009 Share Posted September 6, 2009 Hi there, Just wondering if anyone can help me. I have a square polygon and want to extrude it using two taper angles, one in the x direction, and one in the y direction. Is this possible? Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 7, 2009 Share Posted September 7, 2009 As mentioned previously, a lot of the command functionality available in the AutoCAD editor did not make it to the VBA (ActiveX) api. In this case, a square polygon extruded with multiple taper angles, the process isn’t directly available from the editor either. The process could probably be done in either VBA or the editor by extruding with a taper equal to the steeper angle and “Slicing” the shallower ones. If you are still interested in pursuing this routine let me know, I have some functions that may help the cause. Quote Link to comment Share on other sites More sharing options...
Anna151 Posted September 7, 2009 Share Posted September 7, 2009 Hi there, Yes I would be interested in pursuing this method. Im battling to think of another way of drawing what I need. Quote Link to comment Share on other sites More sharing options...
SEANT Posted September 7, 2009 Share Posted September 7, 2009 I switched tact off of my original suggestion of employing SLICE operations to one of - generate the appropriate line to act as a path, creates extrusion, Copy, Rotate, Intersect. See attached drawing for a visual of the process. The routine is only a prototype so a full complement of error and situation checking is not yet in place. The other limitation is that the routine only processes LWPolylines on the World XY plane. Option Explicit Const PI As Double = 3.14159265358979 Sub UnEqualTaper() '------------------------------------------------------------------------------------- Dim Normal(0 To 2) As Double Dim intCode(7) As Integer Dim varData(7) As Variant Dim lwPL As AcadLWPolyline Dim intCount As Integer With ThisDrawing .Utility.InitializeUserInput 4 Normal(2) = 1# 'create filter for closed LWPolys intCode(0) = 0: varData(0) = "LWPOLYLINE" intCode(1) = -4: varData(1) = "&=" intCode(2) = 70: varData(2) = 1 intCode(3) = -4: varData(3) = "&" intCode(4) = 70: varData(4) = 129 intCode(5) = 90: varData(5) = 4 intCode(6) = 67: varData(6) = 0 intCode(7) = 210: varData(7) = Normal intCount = SoSSS(intCode, varData) - 1 If intCount < 0 Then Exit Sub Dim Sset As AcadSelectionSet Dim i As Integer Dim Ents(0) As AcadEntity Dim entReg As AcadRegion Dim dblOr(0 To 2) As Double Dim dblHeight Dim dblAngX As Double Dim dblAngY As Double Dim varRegs As Variant Dim dblCentroid() As Double Set Sset = ThisDrawing.SelectionSets.Item("TempSSet") dblHeight = .Utility.GetDistance(, vbCr & "Height of extrusion:") dblAngX = .Utility.GetAngle(, vbCr & "Angle (in degrees) for faces perpendicular to X axis: ") dblAngY = .Utility.GetAngle(, vbCr & "Angle (in degrees) for faces perpendicular to Y axis: ") Dim Ln As AcadLine Dim lnTemp As AcadLine Dim entSolid As Acad3DSolid Dim entSolidTemp As Acad3DSolid Set Ln = .ModelSpace.AddLine(dblOr, EndFromAngles(dblHeight, dblAngX, dblAngY)) For i = 0 To intCount Set Ents(0) = Sset.Item(i) varRegs = .ModelSpace.AddRegion(Ents) Set entReg = varRegs(0) dblCentroid = RegCentroidConversion(entReg.Centroid) Set lnTemp = Ln.Copy lnTemp.Move dblOr, dblCentroid Set entSolid = .ModelSpace.AddExtrudedSolidAlongPath(entReg, lnTemp) Set entSolidTemp = entSolid.Copy entSolidTemp.Rotate dblCentroid, PI entSolid.Boolean acIntersection, entSolidTemp lnTemp.Delete entReg.Delete Ents(0).Delete Next Ln.Delete End With End Sub Sub SSClear() Dim SSS As AcadSelectionSets On Error Resume Next Set SSS = ThisDrawing.SelectionSets If SSS.count > 0 Then SSS.Item("TempSSet").Delete End If End Sub Function SoSSS(Optional grpCode As Variant, Optional dataVal As Variant) As Integer Dim TempObjSS As AcadSelectionSet SSClear Set TempObjSS = ThisDrawing.SelectionSets.Add("TempSSet") 'pick selection set If IsMissing(grpCode) Then TempObjSS.SelectOnScreen Else TempObjSS.SelectOnScreen grpCode, dataVal End If SoSSS = TempObjSS.count End Function Function EndFromAngles(ByVal Height As Double, AngX As Double, AngY As Double) As Double() Dim dblDummy(0 To 2) As Double dblDummy(0) = -(Height * Tan(AngX)) dblDummy(1) = -(Height * Tan(AngY)) dblDummy(2) = Height EndFromAngles = dblDummy End Function Function RegCentroidConversion(Point2d As Variant) As Double() Dim dblDummy(0 To 2) As Double dblDummy(0) = Point2d(0) dblDummy(1) = Point2d(1) dblDummy(2) = 0# RegCentroidConversion = dblDummy End Function TaperedSolid.dwg Quote Link to comment Share on other sites More sharing options...
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.