Select with crossing/window

Hi,

I need the users to select objects on the model space, but for now the only
way I know of is asking the user for 2 points, I then use the 2 points to do
a SelectionSet Window or crossing giving those two points.

Is there a way the user could "see" the window beeing drawn, like it does in
Autocad.


Thanks.

 

Have you considered the SelectOnScreen method of the selection set object?


Regards,
Jacob.

 

I did, but a few days ago, I had problems keeping the objects in the
selectionset... I posted,

The code below stops working and Sset.Count returns zero after the first
For... Next

I changed my selection method and solved the problem!!


HI,

I have a very simple subs that crashes, after passing only one entity,

What I'm trying to achieve is getting the mid point of the second vertex, of
each LWpolyline select with the SSet.

It seems to be crashing at this line...

Set tmpPT = ThisDrawing.ModelSpace.AddPoint(ptMilieuDbl)


Sub Histogramme()
Dim Sset As AcadSelectionSet, ent As AcadEntity, pt1 As Variant, pt2 As
Variant
Dim objpoly As AcadLWPolyline, Vtx1 As Variant, Vtx2 As Variant
Dim tmpPT As AcadPoint, angle As Double, Vtx1_3D(0 To 2) As Double,
Vtx2_3D(0 To 2) As Double
Set Sset = Nothing
Set Sset = ThisDrawing.PickfirstSelectionSet
Sset.Clear
Sset.Clear
pt1 = ThisDrawing.Utility.GetPoint(, "point1")
pt2 = ThisDrawing.Utility.GetPoint(, "point2")
Sset.Select acSelectionSetCrossing, pt1, pt2
Dim ptMilieu As Variant, dist As Double, ptMilieuDbl(0 To 2) As Double
If Sset.count > 0 Then
For Each ent In Sset
If TypeName(ent) = "IAcadLWPolyline" Then
Set objpoly = ent
Vtx1 = objpoly.Coordinate(1)
Vtx2 = objpoly.Coordinate(2)
Vtx1_3D(0) = Vtx1(0)
Vtx1_3D(1) = Vtx1(1)
Vtx1_3D(2) = 0
Vtx2_3D(0) = Vtx2(0)
Vtx2_3D(1) = Vtx2(1)
Vtx2_3D(2) = 0
angle = calcAngle(Vtx1_3D, Vtx2_3D)
dist = Distance(Vtx1_3D, Vtx2_3D)
ptMilieu = ThisDrawing.Utility.PolarPoint(Vtx1_3D, angle,
dist / 2)
ptMilieuDbl(0) = ptMilieu(0)
ptMilieuDbl(1) = ptMilieu(1)
ptMilieuDbl(2) = 0
Set tmpPT = ThisDrawing.ModelSpace.AddPoint(ptMilieuDbl)
Set tmpPT = Nothing
End If
Next
End If
End Sub