DOES anyone know anything about this lisp routine i found it at my work but i can't find anyone on the web who has it,
it works great but there is one small problem it doesn't work with polylines like it says it will
if anyone can figure what happened to it, that made it stop working with plines, please let me know. i think it had to be one of those revisions that was made to it.
;; This is "LineLetter" -- a lisp program that breaks a line, an arc,
;; a polyline, a circle, or an ellipse
;; and places text at the break at the angle of the entity where the break
;; is made.
;; ver. 1.04
;; added GetLetterWidth function to kind of determine width of text and
;; width factor
;;
;; ver. 1.05
;; added GetNearer to fix osnap "near" problems
;;
;; ver. 1.06
;; added GetText to have default text ability
;;
;; ver. 1.07 (by Andy Pilson, 03-02-2001)
;; added LAY variable. Stores line layer info.
;; added change command to change text to LAY variable and COLOR 30.
(setq ver "1.06") ;; version number; change when updates are made
(princ (strcat "\n\n'LineLetter' Ver. " ver "\n"))
;;custom error handler
(defun d_err (st)
(princ (strcat "\nError: " st "\n"))
(terpri)
(ResetDefaults)
(setq *error* old_err) ;;reset old error handler
(princ)
);;error
(defun C:LineLtr (/ pt1 aline TheLine entity tsize TextHeight TheAngle ts
TheText TextAngle old_cmdecho old_regen old_osmode
old_err textwidth theent SaveDefaults SetSetvars
ResetDefaults LBreak RightEnt GetTextAngle
GetTextHeight GetLetterWidth GetNearer LAY)
;;save system defaults
(defun SaveDefaults ()
(setq old_cmdecho (getvar "CMDECHO"))
(setq old_regen (getvar "REGENMODE"))
(setq old_osmode (getvar "OSMODE"))
(setq old_aunits (getvar "AUNITS"))
(setq old_highl (getvar "HIGHLIGHT"))
);;SaveDefaults
;;set system variables
(defun SetSetvars ()
(setvar "CMDECHO" 0)
(setvar "REGENMODE" 0)
(setvar "OSMODE" 512)
(setvar "AUNITS" 0)
(setvar "HIGHLIGHT" 0)
);; SetSetvars
;;reset system variables to previous values
(defun ResetDefaults ()
(setvar "CMDECHO" old_cmdecho)
(setvar "REGENMODE" old_regen)
(setvar "OSMODE" old_osmode)
(setvar "AUNITS" old_aunits)
(setvar "HIGHLIGHT" old_highl)
(redraw theent)
);;ResetDefaults
(setq C_LAY (GETVAR "CLAYER"))
;;routine to break line according to text length
(defun LBreak (pt1 TheAngle len theent / LetterLen b1 b2)
(setq LetterLen (/ len 1.5))
(setq b1 (polar pt1 TheAngle LetterLen))
(setq b2 (polar pt1 (+ TheAngle 3.14) LetterLen))
(command "BREAK" theent b1 b2)
);;end LBreak
;;routine to get correct entity name
(defun RightEnt (entity aline / nxtent seqend theent)
(if (= entity "VERTEX")
(progn
(setq nxtent (entnext (car aline)))
(setq seqend (cdr (assoc 0 (entget nxtent))))
(while (/= seqend "SEQEND")
(setq nxtent (entnext nxtent))
(setq seqend (cdr (assoc 0 (entget nxtent))))
);;end while
(setq theent (cdr (assoc -2 (entget nxtent))))
);;end progn
(setq theent (car aline));;else
);;end if
);;end RightEnt
;;get rotation angle of text according to entity type
(defun GetTextAngle (entity TheLine pt1)
(if (= entity "LINE")
(angle (cdr (assoc 10 TheLine)) (cdr (assoc 11 theline)))
(if (= entity "VERTEX")
(angle pt1 (cdr (assoc 10 TheLine)))
(- (angle (cdr (assoc 10 TheLine)) pt1) (dtr 90))
);;end if
);;end if
);;end GetTextAngle
;; decide whether text height is fixed or not and act accordingly
(defun GetTextHeight()
(princ "\n")
(setq ts (tblsearch "STYLE" (getvar "TEXTSTYLE")) ;;'ts' is global now
TextHeight nil) ;;TextHeight is also global
(if (= (cdr (assoc 40 ts)) 0.0)
(progn
(initget 6)
(setq TextHeight (getreal (strcat "\nEnter text height <"
(rtos (getvar "TEXTSIZE") 2 1) ">: ")))
(if (null TextHeight)
(setq TextHeight (getvar "TEXTSIZE"))
(setvar "TEXTSIZE" TextHeight)
);;end if
);;end progn
);;end if
(cdr (assoc 41 ts)) ;;returns text width factor
);;end GetTextHeight
;; determine width of letters to make correct break size
(defun GetLetterWidth (TheText height width / thin fat len a letter)
(if (null height)
(setq height (cdr (assoc 40 ts)))
);;end if
(setq thin (list "f" "I" "i" "j" "l" "t" "1")
fat (list "m" "M" "w" "W")
len 0
a 1
);;end setq
(setq letter (substr TheText a 1))
(while (/= letter "")
(if (/= (member letter thin) nil)
(setq len (+ len (* height (* width 1))))
(if (/= (member letter fat) nil)
(setq len (+ len (* height (* width 1))))
(setq len (+ len (* height width)))
);;end if
);;end if
(setq a (+ a 1)
letter (substr TheText a 1)
);;end setq
);;end while
(setq len len)
);;end GetLetterWidth
;;routine in lieu of the hardly functional "near" osnap
(defun GetNearer (entity theline pt1 / np1 np2 np4 nxtent)
(setq np1 (cdr (assoc 10 theline)))
(if (or (= entity "LINE") (= entity "VERTEX"))
(progn
(if (= entity "LINE")
(setq np2 (cdr (assoc 11 theline)))
(progn ;;else VERTEX
(setq nxtent (entnext (cdr (assoc -1 theline))))
(setq np2 (cdr (assoc 10 (entget nxtent)))) ;;find 2nd point
);;end progn
);;end if
(setq np4 (polar pt1 (- (angle np1 np2) (dtr 90)) 1))
(inters np1 np2 pt1 np4 nil) ;;returns point on line
);;end progn
(progn ;;else entity is arc or circle
(setq np2 (cdr (assoc 40 theline)))
(polar np1 (angle np1 pt1) np2) ;;returns point on arc
);;end progn
);;end if
);;end GetNearer
;;check for default text
(defun GetText (/ thetext)
(if (null ll_txt) ;;ll_txt is global, contains default text
(progn
(initget 1)
(princ "\nEnter letter(s): ")
);;end progn
(progn ;;else
(princ "\nEnter letter(s)/<")
(princ (strcat ll_txt ">: "))
);;end progn
);;end if
(setq thetext (getstring))
(if (and (= thetext "") (/= ll_txt nil))
(setq thetext ll_txt)
(setq ll_txt thetext)
);;end if
);;end GetText
;;main program
(COMMAND "COLOR" "CYAN"); set current color to 30
(setq old_err *error*
*error* d_err)
(graphscr)
(SaveDefaults)
(SetSetvars)
(princ "\n\nThis works with lines, polylines, ellipses, circles, and arcs.")
(princ "\nSelect point on the entity where text is to be inserted.\n")
(setq aline (nentsel))
(setq TheLine (entget (car aline)))
(setq lay (cdr (assoc 8 TheLine)));sets LAY to layer of line
(setq entity (cdr (assoc 0 TheLine)))
(if (and (or (= entity "LINE") (= entity "VERTEX") (= entity "ARC")
(= entity "CIRCLE")) (= (length (last aline)) 3))
(progn
(setq theent (RightEnt entity aline))
(redraw theent 3)
(setq pt1 (osnap (cadr aline) "near"))
(if (null pt1)
(progn
(setq pt1 (cadr aline))
(setq pt1 (GetNearer entity TheLine pt1))
);;end progn
);;end if
(setq textwidth (* (GetTextHeight) 1.2))
(setq TheAngle (GetTextAngle entity TheLine pt1))
(setq TheText (GetText))
(if (/= TheText "")
(progn
(if (and (> (rtd TheAngle) 95) (< (rtd TheAngle) 275))
(setq TextAngle (- (rtd TheAngle) 180))
(setq TextAngle (rtd TheAngle))
);;end if
(setq len (GetLetterWidth TheText TextHeight textwidth))
(LBreak pt1 TheAngle len theent)
(setvar "OSMODE" 0)
(cond
(TextHeight
(command "TEXT" "J" "M" pt1 TextHeight TextAngle TheText))
((null TextHeight)
(command "TEXT" "J" "M" pt1 TextAngle TheText))
);;end cond
);;end progn
(princ "\n\nNo text. No break.")
);;end if
);;end progn
(princ "\n\nEntity picked is not the correct type.\n")
);;end if
(ResetDefaults)
(setq *error* old_err)
(princ)
(command "CHANGE" "L" "" "P" "LA" LAY ""); changes text to LAY
(COMMAND "COLOR" "BYLAYER")
(COMMAND ".layer" "set" c_lay "")
);;end LineLtr
(princ "Type LINELTR to start.")
(princ)
;;end program