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


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
版主帮我看一下是什么问题,问了你这么多问题我以为就解决了,可是到最后还是出现了问题,看来还经继续学习.

gzhhongquan 发表于 2007-2-3 10:01:00

我昨天晚上回去想了一下,原来是变量templ应该定义为数组才对,因为AddRegion(templ)方法要求templ为数组列表。谢谢版主对我前面几个问题的帮助,同时自己也感觉到有小小成就。

兰州人 发表于 2007-2-6 19:38:00

我在使用中经常遇到Variant的问题,解决方法是用debug.print Typename(aa),判断是何种数据类型,如何是Variant, debug.print aa(0),aa(1)获取数据值.
页: [1]
查看完整版本: 请教一个关于面域的属性引用问题