PDA

View Full Version : acSelectionSetCrossing Issues



Pwned555402908
2012-02-02, 09:01 PM
Hi, I've been having some problems using acSelectionSetCrossing for a drawing recently.

This is the code I have for the ss, with p1 being the bottom left and p2 being the top right.
ss.Select acSelectionSetCrossing, p1, p2, dxfcode, DxfData

When I zoom out completely and select points that should include a lot of entities in the ss it comes back with nothing. However if I change it to acSelectionSetAll then it returns the correct results.

My question is what can cause this mismatch of results even though I have done a zoom extents and selected every single thing on the drawing within my p1 and p2 for acSelectionSetCrossing?

Thanks

fixo
2012-02-03, 07:18 PM
You have to use array() of Doubles as the argument instead of pushing separate points
Try this one from my very oldies:


Option Explicit
Sub test()
Dim oPoly As AcadLWPolyline
Dim oEnt As AcadEntity
Dim varPt As Variant
Dim vexPt As Variant
Dim i As Integer
Dim j As Integer
Dim vxsArr() As Variant
Dim outArr() As Variant
ThisDrawing.Utility.GetEntity oEnt, varPt, "Select polyline"
Set oPoly = oEnt
i = (UBound(oPoly.Coordinates) + 1) \ 2 - 1
For j = 0 To i
vexPt = oPoly.Coordinate(j)
ReDim Preserve vxsArr(j)
vxsArr(j) = vexPt
Next
outArr = ConvTo3dPoints(FlattenArray(RemoveDupVexs(vxsArr)), oPoly.Elevation)
ReDim ptArr(0 To UBound(outArr)) As Double
For i = 0 To UBound(outArr)
ptArr(i) = CDbl(outArr(i))
Next

Dim setObj As AcadSelectionSet
Dim setColl As AcadSelectionSets
Dim objEnt As AcadEntity
Dim plineObj As AcadLWPolyline
Dim oText As AcadText
Dim pickPnt As Variant
Dim setName As String
Dim selMod As Long
Dim vertPts As Variant
Dim dblElv As Double
Dim gpCode(1) As Integer
Dim dataValue(1) As Variant
Dim dxfcode, dxfdata
Dim selPts As Variant

On Error GoTo SayMeAbout
gpCode(0) = 0: gpCode(1) = 8
dataValue(0) = "TEXT": dataValue(1) = "0"
dxfcode = gpCode: dxfdata = dataValue
setName = "$PolygonSelect$"

With ThisDrawing
Set setColl = .SelectionSets
For Each setObj In setColl
If setObj.Name = setName Then
.SelectionSets.Item(setName).Delete
Exit For
End If
Next
Set setObj = .SelectionSets.Add(setName)
End With
selMod = acSelectionSetCrossingPolygon ' <-- can use also acSelectionSetWindowPolygon '
'\\' change mode to your suit
setObj.SelectByPolygon selMod, ptArr, dxfcode, dxfdata
setObj.Highlight True
MsgBox "Selected: " & CStr(setObj.Count)
' >> do your stuffs here
For Each objEnt In setObj
Set oText = objEnt
oText.Layer = oPoly.Layer
oText.TrueColor = oPoly.TrueColor
oText.Update
Next

SayMeAbout:
MsgBox Err.Description 'If Err.Number = -2147352567

End Sub


Public Function ConvTo3dPoints(objCoors As Variant, dblElv As Double) As Variant
Dim i As Long, j As Long
Dim convPts() As Variant

j = 0
For i = LBound(objCoors) To UBound(objCoors) Step 2
ReDim Preserve convPts(0 To j)
convPts(j) = CDbl(objCoors(i))
ReDim Preserve convPts(0 To j + 1)
convPts(j + 1) = CDbl(objCoors(i + 1))
ReDim Preserve convPts(0 To j + 2)
convPts(j + 2) = dblElv
j = j + 3

Next
ConvTo3dPoints = convPts

End Function
Function IsEqual(a As Double, b As Double, fuzz As Double) As Boolean
' by TT
If Abs(a - b) <= fuzz Then
IsEqual = True
End If

End Function ' ok
Function IsPointsEqual(p1 As Variant, p2 As Variant, fuzz As Double) As Boolean
' by Fatty (looks ugly but works)
Dim i As Integer
Dim Check As Boolean

Check = True

If IsEqual(CDbl(p1(0)), CDbl(p2(0)), fuzz) = False Then
Check = False
Exit Function
End If
If IsEqual(CDbl(p1(1)), CDbl(p2(1)), fuzz) = False Then
Check = False
Exit Function
End If
If UBound(p1) = 2 Then
If IsEqual(CDbl(p1(2)), CDbl(p2(2)), fuzz) = False Then
Check = False
Exit Function
End If
End If

IsPointsEqual = Check

End Function ' ok
Function RemoveDupVexs(ByVal strArr As Variant) As Variant
Dim clearArr() As Variant
Dim unitStr As Variant
Dim storeColl As New Collection
Dim findCheck As Boolean
Dim i, k As Long

For i = 0 To UBound(strArr)
For Each unitStr In storeColl
If IsPointsEqual(unitStr, strArr(i), 0.00001) = True Then
findCheck = True
End If
Next

If findCheck = False Then
storeColl.Add strArr(i)
Else
findCheck = False
End If
Next
i = storeColl.Count - 1
ReDim clearArr(0 To i) As Variant

For k = 0 To storeColl.Count - 1
clearArr(k) = storeColl(k + 1)
Next
RemoveDupVexs = clearArr
End Function

Function FlattenArray(sourceArr As Variant) As Variant
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim varPt As Variant
Dim outArr() As Variant
j = 0
For i = 0 To UBound(sourceArr)
For k = 0 To 1
ReDim Preserve outArr(j)
outArr(j) = CDbl(sourceArr(i)(k))
j = j + 1
Next k
Next i
FlattenArray = outArr
End Function


~'J'~

Pwned555402908
2012-02-03, 09:28 PM
Thanks for the reply,

For acSelectionSetCrossingPolygon I might have to use an array of doubles,
but for acSelectionSetCrossing it is supposed to accept two point values.
The code I have works for every drawing I've tried it on except for
this one drawing.

BlackBox
2012-02-04, 02:34 AM
Correct me if I am mistaken, but is selecting from left to right not a 'window' selection? Making a 'crossing' selection from right to left.

arshiel88
2012-02-04, 07:27 AM
Correct me if I am mistaken, but is selecting from left to right not a 'window' selection? Making a 'crossing' selection from right to left.

I may be wrong but I really don't think selecting from left to right applies in this situation since a selection mode has been issued, the acSelectionSetCrossing. Its like in AutoCAD GUI, issuing a "window" or "w" selection mode and you can pick from right to left but still window mode is applied instead of crossing mode.

Update: I made some testings and its working fine both acSelectionSetWindow and acSelectionSetCrossing. Maybe the error is caused by another argument. How about the points, did you try using Utility.GetPoint?

BlackBox
2012-02-04, 07:42 PM
I may be wrong but I really don't think selecting from left to right applies in this situation since a selection mode has been issued, the acSelectionSetCrossing. Its like in AutoCAD GUI, issuing a "window" or "w" selection mode and you can pick from right to left but still window mode is applied instead of crossing mode.


As I have not tried coding this functionality for myself (yet), I appreciate the clarification. :beer:

Pwned555402908
2012-02-07, 06:15 PM
Thanks for the replies, sorry I wasn't getting any notification emails so I didn't know there was a response.

I am using Utility.GetPoint for the first and second point. When I debug the points are correct and outside of what I am trying to select. Are there any known properties/issues with a drawing that can cause problems using acSelectionSetCrossing?

The part that is bothering me is that it works for all but one drawing I've tested it on so far. Therefore I am assuming that it's some property of the drawing that is causing the problem. Sadly I am not allowed to share the drawing.

Again acSelectionSetAll returns some 150+ entities, but zooming extents and then farther out afterwards and picking two points way outside of the drawing returns 0.

arshiel88
2012-02-08, 08:41 AM
I am not aware of any property that causes this behavior. Since we can not examine the drawing, we can only make some educated guesses.

1. The objects are too far from the origin.
2. When you pick the 2nd point, you panned until the first point is no longer visible. Somehow the effect of this is the first point being neglected and used the extents of the screen as limits. Therefore objects not visible in the current view are not selected.

This is consistent even in the GUI, when you select objects by normal means.( i.e. not programmatically.)

Pwned555402908
2012-02-24, 11:34 PM
This problem hasn't been duplicated in another drawing so I'm not going to worry about it for now. If it happens again I'll look into it some more, hopefully it was some sort of anomaly.