align text as per adjacent object's alignment

[priyanka_mehta]

Hi all,

 

Is there an automatic way to align text as per the alignment of its adjacent line/object.

 

Thanks and Regards,

Priyanka

[David Bethel]

Depending on the entity type, why not use UCS _E prior to creating the text? -David

[borgunit]

I wrote this a while back. Be aware, the units were for metric.

 

http://mechcad-insider.blogspot.com/2009/03/get-in-align.html

[lpseifert]

Look for Talon.lsp by the very generous ASMI

http://www.asmitools.com/Files/Programs.html

[Lee Mac]

Look for Talon.lsp by the very generous ASMI

http://www.asmitools.com/Files/Programs.html

 

^^ Such a great LISP

[priyanka_mehta]

Thank you all for the help..

 

Finally i came out with collecting the angle of line using mathematical formula i.e.

 

bearing = tan(inverse) = y2-y1/x2-x1

 

and provided this bearing to the textobject.

 

Ultimately i wanted to retrieve length, create a text of the length with the same rotation as line

 

hence, it came out to be like this:

 

[b][font=Times New Roman][/font][/b]
[font=Times New Roman][size=3][b]‘Collects Length, Creates a text of its length at the midpoint of the line at the same rotation as line[/b]

Private Sub cmdlength_Click()
                      
On Error Resume Next

[b]‘Collects Length[/b]

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
Dim coordstart As Variant
Dim basepoint(0 To 2) As Double
Dim col As New AcadAcCmColor
Call col.SetRGB(127, 0, 0)



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
           ' MsgBox endPoint
       lenstring = Round(entLine.Length)
       
       '  MsgBox lenstring
'     Case "AcDb2dPolyline"
'        Set entPoly = objEnt
'        coord = entPoly.Coordinate(0)
'        lenstring = Round(entPoly.Length)
'       MsgBox lenstring
         
    Case "AcDbPolyline"
       Set entLWPoly = objEnt
      ' endPoint = entLine.endPoint
      coordend = entLWPoly.Coordinate(1)
      coordstart = entLWPoly.Coordinate(0)
       
      x1 = coordstart(0)
      y1 = coordstart(1)
   
      x2 = coordend(0)
      y2 = coordend(1)
      
         'MsgBox x1 & "," & y1
      
      midpoint = (coordend(0) + coordstart(0)) / 2 & " , " & (coordend(1) + coordstart(1)) / 2
   
         ' entLWPoly.Rotate midpoint, rotationAngle
     lenstring = Round(entLWPoly.Length)
     
      x = (coordend(0) + coordstart(0)) / 2
      y = (coordend(1) + coordstart(1)) / 2
      

[b]‘Collects rotation angle of line[/b]
      bearing = (y2 - y1) / (x2 - x1)
      bearing = Atn(bearing)
      
    End Select
   
   Dim textobj As AcadText
   Dim textString As String
   Dim insertionPoint(0 To 2) As Double
   Dim height As Double
   
   ' Define the text object
   textString = lenstring
   insertionPoint(0) = x: insertionPoint(1) = y + 15: insertionPoint(2) = 0
   height = 22
   
   ' Create the text object in model space
   Set textobj = ThisDrawing.ModelSpace.AddText(textString & "m", insertionPoint, height)
   textobj.Rotation = bearing
'    If bearing = 0 Then
'    textobj.Rotation = 0
'    End If

   textobj.TrueColor = col
   textobj.StyleName = "ArialBold"
  
  Next
[/size][/font]

 

 

I still have a problem,,, i ve created all this in a VB form and there are a lot other buttons for various purposes in this form... To access it I am using a .lsp

 

 

 

(vl-load-com)(defun C:APID()(vl-vbarun 
"Path\\Projectdvb!initialize")) 

 

 

But, i have to hard code the path for this.. is it possible to create a DLL or some exectuable of VB form

 

Thanks and Regards,

Priyanka