21 | 08 | 2017

Revolve Object (and create bottle)

The code below shows how to combine lines object, arc and how you can transform them into 3d objects. 

 

Sub CreateBottle()

Dim lineObj As AcadLine
Dim lineStart(0 To 2) As Double
Dim lineEnd(0 To 2) As Double
Dim cp(0 To 2) As Double


'Define the first 2d line points
lineStart(0) = 0: lineStart(1) = 0
lineEnd(0) = 0: lineEnd(1) = 120
Set lineObj = ThisDrawing.ModelSpace.AddLine(lineStart, lineEnd)

'Define the second 2d line points
lineStart(0) = 9: lineStart(1) = 120
lineEnd(0) = 0: lineEnd(1) = 120
Set lineObj = ThisDrawing.ModelSpace.AddLine(lineStart, lineEnd)

'Define the third 2d arc points..................etc etc
cp(0) = 9: cp(1) = 117.5
Set myarc = ThisDrawing.ModelSpace.AddArc(cp, 2.5, -90 * 3.141592 / 180#, 90 * 3.141592 / 180#)
'* 3.141592 / 180# is used to convert radial values to degrees

cp(0) = 9: cp(1) = 114
Set myarc = ThisDrawing.ModelSpace.AddArc(cp, 1, 90 * 3.141592 / 180#, 270 * 3.141592 / 180#)

cp(0) = 9: cp(1) = 110.5
Set myarc = ThisDrawing.ModelSpace.AddArc(cp, 2.5, -90 * 3.141592 / 180#, 90 * 3.141592 / 180#)

lineStart(0) = 9: lineStart(1) = 108
lineEnd(0) = 9: lineEnd(1) = 70
Set lineObj = ThisDrawing.ModelSpace.AddLine(lineStart, lineEnd)

cp(0) = 9: cp(1) = 55
Set myarc = ThisDrawing.ModelSpace.AddArc(cp, 15, 0, 90 * 3.141592 / 180#)

lineStart(0) = 24: lineStart(1) = 55
lineEnd(0) = 24: lineEnd(1) = 5
Set lineObj = ThisDrawing.ModelSpace.AddLine(lineStart, lineEnd)

cp(0) = 19: cp(1) = 5
Set myarc = ThisDrawing.ModelSpace.AddArc(cp, 5, 270 * 3.141592 / 180#, 0)

lineStart(0) = 19: lineStart(1) = 0
lineEnd(0) = 0: lineEnd(1) = 0
Set lineObj = ThisDrawing.ModelSpace.AddLine(lineStart, lineEnd)

'Convert Lines and Arcs to polylines
SendCommand "Pedit" & vbCr & "Multiple" & vbCr & "All" & vbCr & vbCr & vbCr & "Join" & vbCr & "1" & vbCr & "C" & vbCr
SendCommand Chr(27) 'Clear commandline

'Sendcommand to revolve the polylines
SendCommand "Revolve" & vbCr & "All" & vbCr & vbCr & "0,0,0" & vbCr & "0,100,0" & vbCr & "360" & vbCr

'Set the view to isometric
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


The result is show below


"The result from the code above"

Download AutoCad sample Here

Login

Sign up now and upload your code to the website.

Help us to continue.....
Statistics
Articles View Hits
2330666
Latest Articles