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

 

In addition to any replies you might receive or already
received, you may find more information or responses
by posting future VBA related questions in the following
discussion group:

By NNTP discussion group reader at
news://discussion.autodesk.com/autodesk.autocad.customization.vba

By HTTP (web-based) interface at
http://discussion.autodesk.com/forum.jspa?forumID=33

 

Sorry about that...

Won't append again!!