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
Dim SOS As AcadSelectionSetDim objSS As AcadSelectionSetDim intCode(0) As IntegerDim varData(0) As VariantDim objEnt As AcadEntityDim entLine As AcadLineDim entPoly As AcadPolylineDim entLWPoly As AcadLWPolylineDim lenstring As Stringa = 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 IfDim 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 VariantDim x As DoubleDim y As DoubleDim z As DoubleOn Error Resume Next'hide the UserFormfrmKP.Hide'ask user to select a pointPoint = ThisDrawing.Utility.GetPoint(, "Select a point")x = Point(0): y = Point(1): z = Point(2)'redisplay the UserFormfrmAPId.Show'MsgBox x'MsgBox y'**********************************************************************************************'*******************************************************************************************'*******************************************************************************************Dim textObj As AcadMTextDim 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 textStringSet textObj = ThisDrawing.ModelSpace.AddText(textString & " m", insertionPoint, height)
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.
置顶卡
