[VBA]两个问题，很菜，请教

ntchjie

1、如何将选择集内各首尾相连的直线，圆弧或多义先连成多义线，能给出具体的函数或代码吗？

ntchjie

2、遍历选择集内的物体，这些物体都有扩展数据的，我发现遍历后只能读出第一个物体的扩展数据，好像原来定义的xdata为variant类型，第一次赋值后，纪录下来了，第二次不可以重新赋值了，不知道为什么？

雪山飞狐_lzh

用SendCommand方法调用Pedit命令最简单，VBA直接实现的话代码有点复杂，：）


第二个问题没看懂，有代码么？

ntchjie

代码没有拷贝回来，明早再贴上吧。谢谢了。


从论坛里面搜索到SetBulge方法，如果用这个能不能实现？这个是专门对付圆弧的，主要是在圆弧方面有些复杂吧？

雪山飞狐_lzh

提供一个思路吧


1、找到多义线的起始点，如果是闭合的就随便找一个


2、从起始点出发，依次找到下一个点，并记录该段的凸度，直线为0，圆弧的计算在本版找找，至于多义线，涉及正序和反序的问题


3、生成多义线，并设置各段凸度

ntchjie

多谢了，应该不成问题，可以弄出来了。附上我的另外一段代码，请斑竹看看，为什么只能读出第一个数据。 Dim returnobj As Object
Dim prjname As String
Dim ss As Object
Dim gpcode(1) As Integer
Dim datavalue(1) As Variant
Dim xdtype As Variant
Dim xdata As Variant
Dim p As Variant
Dim ent As Object 'On Error Resume Next
Call acadopen
AppActivate "Autocad"
Set acadutil = acadobj.ActiveDocument.Utility
Call acadutil.GetEntity(returnobj, , "..选择任意井")
prjname = returnobj.layer Set ss = acadobj.ActiveDocument.SelectionSets.Add("*TEST*")
gpcode(0) = 8: gpcode(1) = 1001
datavalue(0) = prjname: datavalue(1) = "cj_gx_10"
ss.Select 5, , , gpcode, datavalue
'ss.selectonscreen gpcode, datavalue
If ss.Count = 0 Then
ss.Delete
Exit Sub
Else:
grid.Rows = 1
For Each ent In ss
'逐个加入表格
grid.AddItem (grid.Rows)
returnobj.GetXData "cj_gx_10", xdtype, xdata
grid.TextMatrix(grid.Rows - 1, 1) = xdata(4)
grid.TextMatrix(grid.Rows - 1, 2) = ent.Handle
grid.TextMatrix(grid.Rows - 1, 5) = xdata(3)
Next ent
End If
ss.Delete 上面是vb代码，可以读出当前图形中所有的含某特定扩展数据的物体，我看了一下，实体的句饼是不同的也就是确实把各个实体读了出来，但是用returnobj.GetXData "cj_gx_10", xdtype, xdata 获取实体的扩展数据的时候，第一次是能获得的，到第二次的时候好像是不能获得的，所以写出来的数据都是和第一次相同的。我想是可能xdtype, xdata不为空的原因，不知道是不是这个？又需要如何处理？ 谢谢了。

雪山飞狐_lzh

returnobj.GetXData "cj_gx_10", xdtype, xdata?


是


ent.GetXData "cj_gx_10", xdtype, xdata吧

ntchjie

这个错误很弱智，sorry。