长方体：
Sub Example_AddBox()
' This example creates a box in model space.
Dim boxObj As Acad3DSolid
Dim length As Double, width As Double, height As Double
Dim center(0 To 2) As Double
' Define the box
center(0) = 5#: center(1) = 5#: center(2) = 0
length = 5#: width = 7: height = 10#
' Create the box (3DSolid) object in model space
Set boxObj = ThisDrawing.ModelSpace.AddBox(center, length, width, height)
' Change the viewing direction of the viewport to better see the box
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
------------------------------------------------------------------------
圆锥体:
Sub Example_AddCone()
' This example creates a cone in model space.
Dim coneObj As Acad3DSolid
Dim radius As Double
Dim center(0 To 2) As Double
Dim height As Double
' Define the cone
center(0) = 0#: center(1) = 0#: center(2) = 0#
radius = 5#
height = 20#
' Create the Cone (3DSolid) object in model space
Set coneObj = ThisDrawing.ModelSpace.AddCone(center, radius, height)
' Change the viewing direction of the viewport to better see the cone
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
-----------------------------------------------
椭圆锥体:
Sub Example_AddEllipticalCone()
' This example creates an elliptical cone in model space.
Dim coneObj As Acad3DSolid
Dim center(0 To 2) As Double
Dim majorRadius As Double
Dim minorRadius As Double
Dim height As Double
' Define the elliptical cone
center(0) = 0#: center(1) = 0#: center(2) = 0#
majorRadius = 10#
minorRadius = 5#
height = 20#
' Create the elliptical cone in model space
Set coneObj = ThisDrawing.ModelSpace.AddEllipticalCone(center, majorRadius, minorRadius, height)
' Change the viewing direction of the viewport to better see the cone
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
----------------------------------------
圆柱体:
Sub AddCylinder()
' This example creates a cylinder in model space.
Dim cylinderObj As Acad3DSolid
Dim radius As Double
Dim center(0 To 2) As Double
Dim height As Double
' Define the cylinder
center(0) = 0#: center(1) = 0#: center(2) = 0#
radius
= 5#
height = 20#
' Create the Cylinder (3DSolid) object in model space
Set cylinderObj = ThisDrawing.ModelSpace.AddCylinder(center, radius, height)
' Change the viewing direction of the viewport to better see the cylinder
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
------------------------------------------------------------------------------
拉伸：
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
--------------------------------------------------------------------------------------------
旋转：
Sub Example_AddRevolvedSolid()
' This example creates a solid from a region
' rotated around an axis.
' 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)
ZoomAll
MsgBox "Revolve the region to create the solid.", , "AddRevolved
Solid Example"
' Define the rotation axis
Dim axisPt(0 To 2) As Double
Dim axisDir(0 To 2) As Double
Dim angle As Double
axisPt(0) = 7: axisPt(1) = 2.5: axisPt(2) = 0
axisDir(0) = 11: axisDir(1) = 1: axisDir(2) = 3
angle = 6.28
' Create the solid
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddRevolvedSolid(regionObj(0), axisPt, axisDir, angle)
ZoomAll
' 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
MsgBox "Solid created.", , "AddRevolvedSolid Example"
End Sub
-----------------------------------------------------------------------------
球：
Sub Example_AddSphere()
' This example creates a sphere in model space.
Dim sphereObj As Acad3DSolid
Dim centerPoint(0 To 2) As Double
Dim radius As Double
centerPoint(0) = 5#: centerPoint(1) = 5#: centerPoint(2) = 0#
radius = 5#
Set sphereObj = ThisDrawing.ModelSpace.AddSphere(centerPoint, radius)
' 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
------------------------------------------------------------------------------------
圆环：
Sub Example_AddTorus()
' This example creates a torus in model space.
Dim torusObj As Acad3DSolid
Dim centerPoint(0 To 2) As Double
Dim torusRadius As Double
Dim tubeRadius As Double
' Define the torus
centerPoint(0) = 5: centerPoint(1) = 5: centerPoint(2) = 0
torusRadius = 15
tubeRadius = 5
' Create the torus
Set torusObj = ThisDrawing.ModelSpace.AddTorus(centerPoint, torusRadius, tubeRadius)
' 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
-----------------------------------------------------------------------
扫描：
Sub Example_AddExtrudedSolidAlongPath()
' This example extrudes a solid from a region
' along a path defined by a spline.
' 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 path (spline object)
Dim splineObj As AcadSpline
Dim startTan(0 To 2) As Double
Dim endTan(0 To 2) As Double
Dim fitPoints(0 To 8) As Double
' Define the Spline Object
startTan(0) = 10: startTan(1) = 10: startTan(2) = 10
endTan(0) = 10: endTan(1) = 10: endTan(2) = 10
fitPoints(0) = 0: fitPoints(1) = 10: fitPoints(2) = 10
fitPoints(0) = 10: fitPoints(1) = 10: fitPoints(2) = 10
fitPoints(0) = 15: fitPoints(1) = 10: fitPoints(2) = 10
Set splineObj = ThisDrawing.ModelSpace.AddSpline(fitPoints, startTan, endTan)
' Create the solid
Dim solidObj As Acad3DSolid
Set solidObj = ThisDrawing.ModelSpace.AddExtrudedSolidAlongPath(regionObj(0), splineObj)
ZoomAll
End Sub
-------------------------------------------------------------------------------------------------------