AUTOCAD vba 面域拉伸画3D实体报错高手进

xueliang123 · 发表于 2015-1-4 15:49:00

Public Sub Myl()
Dim MyLineObject(0) As AcadLWPolyline
Dim firstsolid As Acad3DSolid
Dim myarea As Variant
Dim BasePoints(11) As Double
BasePoints(0) = 0#
BasePoints(1) = 0#
BasePoints(2) = 55#
BasePoints(3) = -25#
BasePoints(4) = 145#
BasePoints(5) = -25#
BasePoints(6) = 200#
BasePoints(7) = 0#
BasePoints(8) = 145#
BasePoints(9) = 25#
BasePoints(10) = 55#
BasePoints(11) = 25#
Set MyLineObject(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(BasePoints)
MyLineObject(0).Closed = True
Dim H As Double
Dim t As Double
H = 30
t = 0
Set myarea = ThisDrawing.ModelSpace.AddRegion(MyLineObject)
Set firstsolid = ThisDrawing.ModelSpace.AddExtrudedSolid(myarea, H, t)
End Sub

xueliang123 · 发表于 2015-1-4 15:55:00

C:\Users\stx\Desktop\Untitled.jpg

xueliang123 · 发表于 2015-1-4 15:57:00

补发图，一个是报错图一个是面域图，还不能画出3d实体补发图

kj3b3wcgz1y.jpg

zzyong00 · 发表于 2015-1-6 00:20:00

copy

Option Explicit
Public Sub Myl()
Dim MyLineObject(0) As AcadEntity
Dim firstsolid As Acad3DSolid
Dim myarea As Variant
Dim BasePoints(11) As Double
BasePoints(0) = 0#
BasePoints(1) = 0#
BasePoints(2) = 55#
BasePoints(3) = -25#
BasePoints(4) = 145#
BasePoints(5) = -25#
BasePoints(6) = 200#
BasePoints(7) = 0#
BasePoints(8) = 145#
BasePoints(9) = 25#
BasePoints(10) = 55#
BasePoints(11) = 25#
Set MyLineObject(0) = ThisDrawing.ModelSpace.AddLightWeightPolyline(BasePoints)
MyLineObject(0).Closed = True
Dim H As Double
Dim t As Double
H = 30
t = 0
myarea = ThisDrawing.ModelSpace.AddRegion(MyLineObject)
Set firstsolid = ThisDrawing.ModelSpace.AddExtrudedSolid(myarea(0), H, t)
End Sub