Run-Time Automation error...

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

 

I found a clue... but can't relolve it!!!

The Selection set seems to loose it's content (sset.count reads 0) after the
for Each ent in Sset,

 

Well I found it myself!!!

Instead of using Set Sset = ThisDrawing.PickfirstSelectionSet

I used Set Sset = ThisDrawing.SelectionSets.Add("test")

But I still don't see why the other way don't work.


On Error Resume Next
Set Sset = ThisDrawing.SelectionSets.Add("test")
If Err.Description = "The named selection set exists" Then
ThisDrawing.SelectionSets("test").Delete
Set Sset = ThisDrawing.SelectionSets.Add("test")
End If