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