GetEntity return point not ACTUALLY on the entity

Hi

I'm trying to write a routine to find the segment of a LWpolyline that was
selected using Getentity.
I have a sub routine that returns zero if the point is on the segment.

Unfortunately! GetEntity doesn't return the point actually on the line but
just off it (I think this may be something to do with the pickbox).

Anyway, how do I get the point on the line?
In Lisp I'd use Osnap but that doesn't exist in VBA.
& Osmode is ignored when using GetEntity.

Cheers
Dave F.

 

Dave

AFAIK you can do it by following workaround:

- Set 'cursorsize' to apperture size
- Set 'osmode' to 512 (nearest)
- Get the point by 'GetPoint'
- Reset sysvars
- Get the entity by SelectAtPoint

Cheers

 

Thanks, I'll give it ago.

Dave F.

 

Using GetSubEntity instead of GetEntity seems to work. For example
here the user is choosing elements that are to be labled with their
length:

ThisDrawing.Utility.GetSubEntity Object, PickedPoint, TransMatrix,
ContextData
....
Select Case TypeName(Object)
....
Case "IAcadLWPolyline"
Call LableWhichEle(Object, PickedPoint)
..
..
' LableWhichEle uses a simple test to determine which element of the
poly was picked
Private Sub LableWhichEle(ent As AcadObject, pt As Variant)
Dim npairs As Integer
Dim v As Integer
Dim circDir As Integer
Dim Tlen As Double
Dim Pt2T1 As Double
Dim Pt2T2 As Double
Dim pt1(0 To 2) As Double
Dim pt2(0 To 2) As Double
Const tol = 1
npairs = (UBound(ent.Coordinates) + 1) / 2
circDir = PolyCirc(ent) ' poly direction
For v = 0 To npairs - 2
Tlen = Sqr((ent.Coordinate(v)(0) - ent.Coordinate(v + 1)(0)) ^
2 + (ent.Coordinate(v)(1) - ent.Coordinate(v + 1)(1)) ^ 2)
Pt2T1 = Sqr((pt(0) - ent.Coordinate(v)(0)) ^ 2 + (pt(1) -
ent.Coordinate(v)(1)) ^ 2)
Pt2T2 = Sqr((ent.Coordinate(v + 1)(0) - pt(0)) ^ 2 +
(ent.Coordinate(v + 1)(1) - pt(1)) ^ 2)
If Abs(Pt2T1 + Pt2T2 - Tlen) < tol Then
pt1(0) = ent.Coordinate(v)(0)
pt1(1) = ent.Coordinate(v)(1)
pt2(0) = ent.Coordinate(v + 1)(0)
pt2(1) = ent.Coordinate(v + 1)(1)
Tlen = ThisDrawing.Utility.AngleFromXAxis(pt1, pt2)
PlaceLenText CStr(Proc4Units(Tlen)), pt1, pt2, circDir
End If
Next
End Sub

AKS