Retrive length + insertion point

[priyanka_mehta]

Hi,

 

I have a code that retrieves length of a line by selection and places this length as a text. The position for placement of text is done by .getpoint. Hence I have to click the line twice, once to retreive the length and another time to get the insertion point to place the text. Please help me with this such that in one click i should have length as well as insertion point of that place for placing text

 

Below is the code:

 

Dim SOS As AcadSelectionSet
Dim objSS As AcadSelectionSet
Dim intCode(0) As Integer
Dim varData(0) As Variant
Dim objEnt As AcadEntity
Dim entLine As AcadLine
Dim entPoly As AcadPolyline
Dim entLWPoly As AcadLWPolyline
Dim lenstring As String
a = 1
 For Each SOS In ThisDrawing.SelectionSets
    If SOS.Name = "MySS" Then
       ThisDrawing.SelectionSets("MySS").Delete
    Exit For
    End If
 Next

 intCode(0) = 0: varData(0) = "LINE,POLYLINE,LWPOLYLINE"
 ThisDrawing.SelectionSets.Add ("MySS")
 Set objSS = ThisDrawing.SelectionSets("MySS")
 objSS.SelectOnScreen intCode, varData

 If objSS.Count < 1 Then
    MsgBox "No lines and polylines selected!"
 Exit Sub
 End If

Dim endPoint As Variant

 For Each objEnt In objSS
 Select Case objEnt.ObjectName
    Case "AcDbLine"
       Set entLine = objEnt
       endPoint = entLine.endPoint
       lenstring = Round(entLine.Length)
  '  MsgBox lenstring

    Case "AcDb2dPolyline"
       Set entPoly = objEnt
       lenstring = Round(entPoly.Length)
     ' MsgBox lenstring

    Case "AcDbPolyline"
       Set entLWPoly = objEnt
     lenstring = Round(entLWPoly.Length)
    ' MsgBox lenstring
    End Select
  Next

'*******************************************************************************************
'*******************************************************************************************
'*******************************************************************************************
Dim Point As Variant
Dim x As Double
Dim y As Double
Dim z As Double
On Error Resume Next
'hide the UserForm
frmKP.Hide
'ask user to select a point
Point = ThisDrawing.Utility.GetPoint(, "Select a point")
x = Point(0): y = Point(1): z = Point(2)
'redisplay the UserForm

frmAPId.Show
'MsgBox x
'MsgBox y

'**********************************************************************************************
'*******************************************************************************************
'*******************************************************************************************
Dim textObj As AcadMText
Dim textobj1 As AcadMText
   Dim textString As String
   Dim insertionPoint(0 To 2) As Double
   Dim height As Double
   Dim textstring1 As String
   ' Define the text object
   textString = Round(lenstring, 2) '& vbCr & Round(txty.Value)
   insertionPoint(0) = x: insertionPoint(1) = y: insertionPoint(2) = 0
    height = 22

    'MsgBox textString

Set textObj = ThisDrawing.ModelSpace.AddText(textString & " m", insertionPoint, height)
  

 

 

 

Thanks and Regards,

Priyanka

[SEANT]

Instead of using a selection set you could use the ThisDrawing.Utility.GetEntity method. That method will return the point used to make the entity selection.

 

It will only work for one entity at a time, however.

[ska67can]

Where, in relation to the line, do you want to place the text?

 

ska