|
|
各位高手：我要选择一封闭多义线内的图元，构建好坐标集后有时能选择到实体有时候选择不到时怎么回事？lisp中用"wf"就能选中，在vba中用acSelectionSetWindowPolygon总是有问题。
请高手指点！下面是代码
Sub jhfsc() '街坊线上传到金图数据库中
Dim cn As New ADODB.Connection
Dim gdeo As New ADODB.Recordset
Dim gdeov As New ADODB.Recordset
Dim gdv3 As New ADODB.Recordset
Dim sqllj, gdeolj, gdeovlj, gdv3lj, jfh As String
Dim jfmj As Double '街坊面积
Dim ftype(0 To 1) As Integer
Dim maxvid, vid, eoid, maxeoid As Long
Dim fdata(0 To 1) As Variant
ftype(0) = 0: fdata(0) = "LWPOLYLINE"
ftype(1) = 8: fdata(1) = "街坊线"
Dim ddzb(), sjzb() As Double '顶点坐标
Dim dds, mode As Integer
Dim zb As Variant
Dim ltime As Date
sqllj = "provider=sqloledb.1;password= ;persist security info=true;user id=sa;initial catalog=wzlz ;data source=hbxx"
cn.Open sqllj
gdv3lj = "select maxvid=max(vid) from gdv3"
gdv3.Open gdv3lj, cn, adOpenForwardOnly, adLockBatchOptimistic
Do While Not gdv3.EOF
maxvid = gdv3.Fields("maxvid")
gdv3.MoveNext
Loop
gdv3.Close
gdeolj = "select maxeoid=max(eoid) from gdeo"
gdeo.Open gdeolj, cn, adOpenForwardOnly, adLockBatchOptimistic
If Not gdeo.EOF Then
maxeoid = gdeo.Fields("maxeoid")
End If
gdeo.Close
On Error Resume Next
Dim xzj As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("st")) Then
Set xzj = ThisDrawing.SelectionSets.Item("st")
xzj.Delete
End If
Set xzj = ThisDrawing.SelectionSets.Add("st") '新建选择集
'MsgBox xzj.Name
xzj.Select acSelectionSetAll, , , ftype, fdata '选择街坊线
Dim ty As AcadEntity
For Each ty In xzj
Dim i As Integer
dds = (UBound(ty.Coordinates) + 1) / 2
zb = ty.Coordinates
jfmj = ty.Area '街坊面积
ReDim ddzb(dds * 3 - 1)
ReDim sjzb(dds - 1, 1)
For i = 0 To dds - 1
ddzb(3 * i) = zb(2 * i) 'y
ddzb(3 * i + 1) = zb(2 * i + 1) 'x
ddzb(3 * i + 2) = 0
sjzb(i, 0) = zb(2 * i)
sjzb(i, 1) = zb(2 * i + 1)
Next i '提取端点坐标
jfh = tqjfh(ddzb)
'gdeolj = "select * from gdeo where description=' " & jfh & "'"
cn.Execute "insert into gdeo (eoid,description,lastuser,lastaction,synchronized,btf,lastupdatetime,area,st) values(" & maxeoid + 1 & "," & jfh & " ,"",0,1,0," & ltime & "," & jfmj & ",1"
For i = 0 To dds - 1
gdv3lj = "select * from gdv3 where x=" & sjzb(i, 1) & " and y= " & sjzb(i, 0) & ""
gdv3.Open gdv3lj, cn, adOpenForwardOnly, adLockBatchOptimistic
If Not gdv3.EOF Then
vid = gdv3.Fields("vid")
Else
vid = maxvid + 1
cn.Execute "insert into gdv3 (vid,eoid,vn,x,y,h,vsp,vxys,vhs,vc,lastupdatetime,vt) values (" & vid & ", " & maxeoid + 1 & "," & sjzb(i, 1) & "," & sjzb(i, 0) & ",0,2,1,1,0," & ltime & ",99)"
End If
cn.Execute "insert into gdeov (eoid,eovo,eovid) values (" & maxeoid + 1 & "," & i + 1 & "," & vid & ")"
maxvid = maxvid + 1
Next
maxeoid = maxeoid + 1
Next 'or Each ty In xzj
End Sub
Function tqjfh(zb) As String '提取街坊号
On Error Resume Next
Dim zjxzj As AcadSelectionSet
If Not IsNull(ThisDrawing.SelectionSets.Item("zjst")) Then
Set zjxzj = ThisDrawing.SelectionSets.Item("zjst")
zjxzj.Delete
End If
Set zjxzj = ThisDrawing.SelectionSets.Add("zjst") '新建选择集
ReDim gpCode(0 To 1) As Integer
gpCode(0) = 0
gpCode(1) = 8
ReDim dataValue(0 To 1) As Variant
dataValue(0) = "MTEXT"
dataValue(1) = "街坊注记"
Dim groupCode As Variant, dataCode As Variant
groupCode = gpCode
dataCode = dataValue
zjxzj.SelectByPolygon acSelectionSetWindowPolygon, zb, groupCode, dataCode'这里总是选择不到实体。
'zjxzj.SelectByPolygon acSelectionSetWindowPolygon, pointsArray, groupCode, dataCode
jfh = "320506" + zjxzj.Item(0).TextString '
'以上提取街坊坐标和街坊号
tqjfh = jfh
End Function
|
|
置顶卡
