;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;幕匠LISP实验室;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;程序功能：字按线对齐   [备注：]
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq *Nblock* 0)
(defun GetNestEntity(ELst / ent1 ss1 pt lst lst1 Obj lst2 ) 
  (setq ent1 (car ELst)
 pt   (cadr ELst)
 lst1 (entget ent1)
        Obj  (cdr (assoc 0 lst1))
 ss1  nil
 n    0
  );;;end setq
  (if (or (wcmatch Obj "INSERT") (wcmatch Obj "LWPOLYLINE") (wcmatch Obj "POLYLINE"))
    (progn
      (command "_.explode" ent1)
      (setq *Nblock* (1+ *Nblock*))
      (if (setq ss1 (ssget pt))
        (setq lst2 (list (ssname ss1 0) pt)
              lst (GetNestEntity lst2))
 (progn
   (command "_.undo" *Nblock*)
   (setq *Nblock* 0)
   (exit)
 )  
      )  
      (list (car lst) (1+ (cadr lst)))
    )
    (list ent1 0)
   
  );;;end if
  
 )
;;;////////////////////////
(DEFUN C:TL (/ lst n ent txt objtype errhandler olderr elst lst1)
  (setq *Nblock* 0)
;;;//////////////////////
(defun errhandler(s)
  (if (/= s "Function cancelled")
       (if (= s "quit / exit abort")
           (princ)
           (princ (strcat "\nError: " s))
        )
   );;;end if
  (if (> n 0) (command "_.undo" n))
  (if olderr (setq *error* olderr))
  (princ ent)(princ)
  (if ent (command "_.erase" ent ""))
  (command "_.undo" "end")
  (if (> n 0) (command "_.undo" n))
);;;end defun 
;;;///////////////////////////
  (command "_.undo" "begin")
  (if *error*
    (setq olderr *error* *error* errhandler)
    (setq *error* errhandler))
  (setvar "cmdecho" 0)
  (setvar "errno" 7)
  (while (= (getvar "errno") 7)
    (setq lst (entsel "\nSelect Object [Line Or Arc]:"))
    (if lst
     (progn
       (setq lst1 (GetNestEntity lst)
             n    (last lst1)
      ent  (car lst1)
      elst (entget ent)
      objtype (cdr (assoc 0 elst))
      *Nblock* 0)
       (if (> n 0) (command "_.undo" n))
       (entmake elst)
       (setq ent (entlast))
       (if (or (wcmatch objtype "LINE")
        (wcmatch objtype "ARC"))
        (wcmatch objtype "CIRCLE"))
 (progn 
         (redraw ent 3)
         (setvar "errno" 7)
         (while (= (getvar "errno") 7)
          (setq txt (entsel "\nSelect text:"))
   (if txt
    (progn
     (setq txt (car txt))
     (if (wcmatch (cdr (assoc 0 (entget txt))) "TEXT")
      (progn 
              (cond
        ((wcmatch (cdr (assoc 0 (entget ent))) "LINE") (TextAlignToLine ent txt))
        ((wcmatch (cdr (assoc 0 (entget ent))) "ARC") (TextAlignToArc ent txt))
        ((wcmatch (cdr (assoc 0 (entget ent))) "CIRCLE") (alert "You pick a Circle"))
              );;;end cond
       (setvar "errno" 0)
     );;;end progn  
    );;;end if
   );;;progn 
          );;;end if
         );;;end while
         (setvar "errno" 0)
  (entdel ent)
       )
       (progn
  (command "_.erase" ent "")
         (setvar "errno" 7)
       );;;end progn
      );;;end if
     );;;end progn 
    );;;end if
  );;;end while
  (command "_.undo" "end")
  (princ)
)
;;;//////////////////
(defun TextAlignToLine(Line Text / LineTable PointStart PointEnd LineAngle TextTable)
  (setq LineTable  (entget Line)
 PointStart (cdr (assoc '10 LineTable))
 PointEnd   (cdr (assoc '11 LineTable))
        LineAngle  (angle PointStart PointEnd)
  )
   (if (or (> (* pi 1.5) LineAngle (* pi 0.5)) (= LineAngle (* pi 1.5)))
    (setq LineAngle (- LineAngle pi))
   );;;end if
  (setq TextTable (entget Text)
 TextTable (subst (cons '50 LineAngle) (assoc '50 TextTable) TextTable))
  (entmod TextTable)
  (setvar "errno" 7)
)
;;;///////////////////////
(defun TextAlignToArc(Arc Text / ArcTable Centerpoint TextTable TextBpt ang)
  (setq ArcTable    (entget Arc)
 Centerpoint (cdr (assoc 10 ArcTable))
 TextTable   (entget Text)
 TextBpt     (cdr (assoc 10 TextTable))
 ang         (+ (angle Centerpoint TextBpt) (/ pi 2))
  )
  (if (> ang (* 2 pi)) (setq ang (- ang (* 2 pi))))
  (if (or (> (* pi 1.5) ang (* pi 0.5)) (= ang (* pi 1.5)))
    (setq ang (- ang pi))
   );;;end if
  (command "_.line" Centerpoint TextBpt "")(princ)
  (setq TextTable  (subst (cons '50 ang) (assoc '50 TextTable) TextTable))
  (entmod TextTable)
  (alert "You pick an Arc")
  (setvar "errno" 7)
)