请教一个关于面域的属性引用问题

gzhhongquan · 发表于 2007-1-22 10:25:00

Public Sub region()
Dim curves(1) As AcadEntity
Dim cp(2) As Double
Dim r As Double
Dim sn, en As Double
cp(0) = 5#
cp(1) = 3#
cp(2) = 0#
r = 2#
sn = 0
en = 3
Set curves(0) = ThisDrawing.ModelSpace.AddArc(cp, r, sn, en)
Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).StartPoint, curves(0).EndPoint)
Dim regionobj As Variant
regionobj = ThisDrawing.ModelSpace.AddRegion(curves)
regionobj(0).color = acRed
Dim pt As AcadPoint
Set pt = ThisDrawing.ModelSpace.AddPoint(regionobj.Centroid)
pt.color = acBlue
ZoomExtents
End Sub
我自己认为错误的原因是：Dim regionobj As Variant，而我后面引用regionobj的Centroid属性应该要求regionobj是acadregion才对吧，我不知道怎么样才能把Variant转换为acadregion类型

wyj7485 · 发表于 2007-1-22 13:32:00

copy


Public Sub region()
Dim curves(1) As AcadEntity
Dim cp(2) As Double
Dim r As Double
Dim sn, en As Double
cp(0) = 5#
cp(1) = 3#
cp(2) = 0#
r = 2#
sn = 0
en = 3
Set curves(0) = ThisDrawing.ModelSpace.AddArc(cp, r, sn, en)
Set curves(1) = ThisDrawing.ModelSpace.AddLine(curves(0).StartPoint, curves(0).EndPoint)
Dim regionobj As Variant
regionobj = ThisDrawing.ModelSpace.AddRegion(curves)
regionobj(0).color = acRed
Dim Myregion As AcadRegion
Set Myregion = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)
        
Dim pt0 As Variant
pt0 = Myregion.CentroidDim pt1(0 To 2) As Double
pt1(0) = pt0(0): pt1(1) = pt0(1): pt1(2) = 0
Dim pt As AcadPoint
Set pt = ThisDrawing.ModelSpace.AddPoint(pt1)
pt.color = acBlue
ZoomExtents
End Sub

gzhhongquan · 发表于 2007-1-23 16:11:00

谢谢了。现在我想把点变为+的形式，查了一下帮助，将PDMODE的值改为2就可以了，可是PDMODE是CAD的系统变量，请问怎么样在VBA中调用CAD的系统变量呢？我试了几次都出错了。

wyj7485 · 发表于 2007-1-24 08:56:00

ThisDrawing.GetVariable "PDMODE" '获取
ThisDrawing.SetVariable "PDMODE", 2 '设置

gzhhongquan · 发表于 2007-1-28 11:23:00

谢谢版主了.又遇到类似问题了,需要你的帮助.
Sub Example_AddPolyline()

Dim plineObj As AcadPolyline
Dim pt1 As Variant
Dim pt2 As Variant
pt1 = ThisDrawing.Utility.GetPoint(, "get point")
pt2 = ThisDrawing.Utility.GetPoint(, "get point")

Dim points(0 To 5) As Variant
points(0) = pt1(0)
points(1) = pt1(1)
points(2) = 0
points(3) = pt2(0)
points(4) = pt2(1)
points(5) = 0

' Create a Polyline object in model space
Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)
ZoomExtents
End Sub
我自己认为出的错是:AddPolyline(points)要求points是OCS坐标值表,而由GetPoint方法得到的点是3D WCS坐标值,由3D WCS坐标值向OCS坐标值可以用TranslateCoordinates方法,我按照帮助文件提供的方法试了一下,还是说Set plineObj = ThisDrawing.ModelSpace.AddPolyline(points)是无效的调用过程.麻烦你帮我看一到底是什么问题.

wyj7485 · 发表于 2007-1-29 08:26:00

Dim points(0 To 5) As Variant定义错误,应该
Dim points(0 To 5) As Double

gzhhongquan · 发表于 2007-2-2 10:02:00

Sub myl()
Dim p1 As Variant '申明端点坐标
Dim p2 As Variant
Dim al() As Double '声明一个动态数组
Dim templ As AcadEntity
p1 = ThisDrawing.Utility.GetPoint(, "输入点:") '获取点坐标
p1(2) = 0 '将Z坐标值赋予点坐标中
ReDim al(0 To 2) '定义动态数组
al(0) = p1(0)
al(1) = p1(1)
al(2) = 0
On Error GoTo Err_Control '出错陷井
Do '开始循环
  p2 = ThisDrawing.Utility.GetPoint(p1, vbCr & "输入下一点:") '获取下一个点的坐标

  p2(2) = 0 '将Z坐值赋予点坐标中

  lub = UBound(al) '获取当前l数组中元的元素个数
  ReDim Preserve al(lub + 3)
  For i = 1 To 3
al(lub + i) = p2(i - 1)
  Next i

  Set templ = ThisDrawing.ModelSpace.AddPolyline(al)  '画多段线
  p1 = p2 '将第二点的端点保存为下一条直线的第一个端点坐标
Loop
Err_Control:
templ.Closed = True
Dim regionobj As Variant
regionobj = ThisDrawing.ModelSpace.AddRegion(templ) '转化为面域
regionobj(0).color = acRed
Dim Myregion As AcadRegion
Set Myregion = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.Count - 1)

Dim pt0 As Variant
pt0 = Myregion.Centroid '引用Centroid属性
Dim pt1(0 To 2) As Double
pt1(0) = pt0(0): pt1(1) = pt0(1): pt1(2) = 0
Dim pt As AcadPoint
Set pt = ThisDrawing.ModelSpace.AddPoint(pt1)
pt.color = acBlue
ThisDrawing.SetVariable "PDMODE", 2
ThisDrawing.SetVariable "PDSIZE", 0.1 '调用系统变量
ZoomExtents
End Sub
版主帮我看一下是什么问题,问了你这么多问题我以为就解决了,可是到最后还是出现了问题,看来还经继续学习.