Im just starting to get my head around VBA in AutoCad. I have managed to write a code that creates a 2D truss in polylines by coordinates I have arranged in an Excel file. Now I need to extrude each member into a cylinder. Well Im not really that smart yet, having some hard time with choosing path and region. Any examples or advice would be much much much appreciated! Please!
Solved! Go to Solution.
Solved by Hallex. Go to Solution.
Hi,
1min to search the help and to get this sample 😉 .... or is there something else that you need help for?
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
Just one sample of extrusion, if you search through the VBA-help for "extrude" you'll find more.
And be careful, VBA is not the product I would start now developing with AutoCAD. On one side since AutoCAD 2010 there's the warning that it may not be continued in future releases and also working within a 64bit-environment pushes the performance down to .... (bad words are truncated by myself ;))
Good luck, - alfred -
Thank you so much for the fast reply! I've got this example already, didn't really ring the bell. Well I really don't have much background in programming full stop so it is not really going anywhere. Ive managed to get some sort of results, but a general design error pups up on the last line where Im trying to AddExtrudeSolidAlongPath method! It is probably something really silly, but I can't find the issue. Here is the code, if you have a second to look at it. Please don't laugh!
Sub Truss_Polyline() Dim excelAPP As Object Set excelAPP = CreateObject("Excel.Application") excelAPP.Workbooks.Open ("d:\demo\Truss Finite Element Software V2.0_mine version.xlsm") Dim pline3DObj As AcadPolyline Dim stP As Long Dim enP As Long Dim i As Long Dim Point(0 To 5) As Double Dim XSection As Double Members = excelAPP.Worksheets("Main Page").Cells(6, 5) For i = 1 To Members stP = excelAPP.Worksheets("Elements").Cells(i + 1, 2) enP = excelAPP.Worksheets("Elements").Cells(i + 1, 3) XSection = excelAPP.Worksheets("Elements").Cells(i + 1, 5) ' Define the start and end points for the line Point(0) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 2): Point(1) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 3): Point(2) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 4) Point(3) = excelAPP.Worksheets("Nodes").Cells(enP + 1, 2): Point(4) = excelAPP.Worksheets("Nodes").Cells(enP + 1, 3): Point(5) = excelAPP.Worksheets("Nodes").Cells(enP + 1, 4) Set pline3DObj = ThisDrawing.ModelSpace.AddPolyline(Point()) Dim objPath As AcadPolyline Dim varRegions As Variant Dim objEnts(0) As AcadEntity Dim radius As Double Dim objCircle As AcadCircle Dim objShape As Acad3DSolid radius = excelAPP.Worksheets("CHS").Cells(13 + XSection, 2) / 2 Set objPath = pline3DObj Dim center(0 To 2) As Double center(0) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 2): center(1) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 3): center(2) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 4) Set objCircle = ThisDrawing.ModelSpace.AddCircle(center, radius) Set objEnts(0) = objCircle varRegions = ThisDrawing.ModelSpace.AddRegion(objEnts) Set objShape = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(varRegions(0), objPath) Next i Set excelAPP = Nothing End Sub
Thanks very much again! Miss Kalnina
Try this one instead
Think you have to use 3d polyline as path of extrusion:
{code}
Option Explicit
Sub Truss_Polyline()
Dim excelAPP As Object
Dim excelBook As Object
On Error GoTo Err_Control
Set excelAPP = CreateObject("Excel.Application")
Set excelBook = excelAPP.Workbooks.Open("c:\Test\Truss Finite Element Software V2.0_mine version.xlsm")
Dim pline3DObj As Acad3DPolyline '<--- use 3d Polyline as extrusion path
Dim stP As Long
Dim enP As Long
Dim i As Long
Dim Point(0 To 5) As Double
Dim XSection As Double
Dim Members As Long
Members = excelAPP.Worksheets("Main Page").Cells(6, 5)
Debug.Print "Members: " & Members
For i = 1 To Members
stP = excelAPP.Worksheets("Elements").Cells(i + 1, 2)
Debug.Print stP
enP = excelAPP.Worksheets("Elements").Cells(i + 1, 3)
Debug.Print enP
XSection = excelAPP.Worksheets("Elements").Cells(i + 1, 5)
' Define the start and end points for the line
Point(0) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 2)
Point(1) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 3)
Point(2) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 4)
Point(3) = excelAPP.Worksheets("Nodes").Cells(enP + 1, 2)
Point(4) = excelAPP.Worksheets("Nodes").Cells(enP + 1, 3)
Point(5) = excelAPP.Worksheets("Nodes").Cells(enP + 1, 4)
Set pline3DObj = ThisDrawing.ModelSpace.Add3DPoly(Point)
Dim objPath As Acad3DPolyline
Dim varRegions As Variant
Dim objEnts(0) As AcadEntity
Dim radius As Double
Dim objCircle As AcadCircle
Dim objShape As Acad3DSolid
radius = excelAPP.Worksheets("CHS").Cells(13 + XSection, 2) / 2
Set objPath = pline3DObj
Dim center(0 To 2) As Double
center(0) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 2)
center(1) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 3)
center(2) = excelAPP.Worksheets("Nodes").Cells(stP + 1, 4)
Set objCircle = ThisDrawing.ModelSpace.AddCircle(center, radius)
ZoomAll
Set objEnts(0) = objCircle
varRegions = ThisDrawing.ModelSpace.AddRegion(objEnts)
Set objShape = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(varRegions(0), objPath)
Next i
excelBook.Close
excelAPP.Quit
Set excelBook = Nothing
Set excelAPP = Nothing
Err_Control:
If Err.Number <> 0 Then
MsgBox Err.Description
End If
End Sub
{code}
~'J'~
Thanks very much again, but still doesn't work. When debuging the code, it stops at set entity showing that the region is empty thus it stops there and jumps to error check. I can't understand why, cause I've done it exactly the same way as in examples. Anyway, the error pups up eventually says that the call was rejected bycallee. The programm still draws one of the members of truss and a circle at the start point, it's just that they are laying in the same plane, which is probably not very promissing. Why is this so complicated?
My guess is this happens by reason of that the every region
should be created in the drawing XY plane in other words
it have the normal vector same as Z axis then you could be able
to extrude them all , so you need to create all parts in this plane, then apply
move and rotate 3d operations then do union all of the parts right
Can you upload your .xlsm (2007) file and drawing example (A2007) how it will be looks like,
maybe I can do it?
~'J'~
Thanks Hallex, i have kinda given up on it, Im trying something else now. If you still wanna have a look at it, that would be awesome. Is .xlsm (2010) alright? Can you please post your personal email?
Sorry no
But you can send your files with www.yousendit.com or so
again I have MS Office 2007 only I'm afraid I can't open Excel 2010
saveas it in this release
and also you may want to look at this thread for more:
http://www.theswamp.org/index.php?topic=13604.0
Here is just a dummy example how to do the work easy
without transformation matrix
{code}
Option Explicit
Sub test()
Dim pl3d1 As Acad3DPolyline
Dim pl3d2 As Acad3DPolyline
Dim pts(0 To 8) As Double
' Create the array of pts
pts(0) = 0: pts(1) = 0: pts(2) = 0
pts(3) = 0: pts(4) = 0: pts(5) = 10
pts(6) = 1#: pts(7) = 0.5: pts(8) = 12.4
' Create first 3DPolyline in model space
Set pl3d1 = ThisDrawing.ModelSpace.Add3DPoly(pts)
Dim varRegions As Variant
Dim objEnts(0) As AcadEntity
Dim radius As Double
Dim objCircle As AcadCircle
Dim objShape1 As Acad3DSolid
Dim objShape2 As Acad3DSolid
radius = 0.5
Dim cpt(0 To 2) As Double
cpt(0) = 0#
cpt(1) = 0#
cpt(2) = 0#
Set objCircle = ThisDrawing.ModelSpace.AddCircle(cpt, radius)
Set objEnts(0) = objCircle
varRegions = ThisDrawing.ModelSpace.AddRegion(objEnts)
Set objShape1 = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(varRegions(0), pl3d1)
' change last point to create a second 3DPolyline, first 2 points is the same
pts(6) = -1#: pts(7) = -0.5: pts(8) = 12.4
' Create second 3DPolyline in model space
Set pl3d2 = ThisDrawing.ModelSpace.Add3DPoly(pts)
Set objShape2 = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(varRegions(0), pl3d2)
' perform union operation to solids
objShape1.Boolean acUnion, objShape2
' define axis line points
Dim axpt1(2) As Double
axpt1(0) = 0#: axpt1(1) = 0#: axpt1(2) = 0#
Dim axpt2(2) As Double
axpt2(0) = 0#: axpt2(1) = 1#: axpt2(2) = 0#
' rotate solid around this axis
objShape1.Rotate3D axpt2, axpt1, 1.5708 '~90 degs
'clean up
objCircle.Delete
varRegions(0).Delete
pl3d1.Delete
pl3d2.Delete
ZoomExtents
End Sub
{code}
Thanks very much, it did help although I changed the method Im using. I don’t have time to sort out the extrusion method but I will give it a try later on.
Many thanks
Hope you could be able to do it yourself
Happy computing and Cheers 🙂
~'J'~
Can't find what you're looking for? Ask the community or share your knowledge.