;;--------------------=={ CurveText.lsp }==-------------------;;
;;                                                            ;;
;;  Positions Text along a curve object (arc, circle, spline, ;;
;;  ellipse, line, lwpolyline, polyline), and rotates text    ;;
;;  to fit to the curve accordingly.                          ;;
;;                                                            ;;
;;  If run in versions > AutoCAD2000, the resultant text will ;;
;;  form an anonymous group.                                  ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version:  1.4    -    22-02-2012                          ;;
;;------------------------------------------------------------;;

(defun c:lm_CurveText ( / LM:CurveText LM:isAnnotative LM:SelectionOrText sel str obj wid1 wid2 )

(defun LM:isAnnotative ( style / obj xdt )
    (and
        (setq obj (tblobjname "STYLE" style))
        (setq xdt (cadr (assoc -3 (entget obj '("AcadAnnotative")))))
        (= 1 (cdr (assoc 1070 (reverse xdt))))
    )
)

(defun LM:SelectionOrText ( msg pred / en g1 g2 gr result )
    (setq pred (eval pred))
    
    (if msg
        (princ msg)
        (princ (setq msg "\nÑ¡ÔñÎÄ×ÖÊµÌå»òÊäÈëÎÄ×Ö:"))
    )
    (setq result "")

    (while
        (progn
            (setq gr (grread t 13 2)
                  g1 (car  gr)
                  g2 (cadr gr)
            )
            (cond
                (   (= 03 g1)
                    (if (setq en (car (nentselp g2)))
                        (if (pred en)
                            (not (setq result en))
                            (princ (strcat "\nÑ¡Ôñ´íµÄÊµÌå." msg))
                        )
                        (princ (strcat "\n¿ÕÑ¡£¬ÔÙÑ¡Ò»´Î." msg))
                    )
                )
                (   (= 02 g1)
                    (cond
                        (   (< 31 g2 127) (setq result (strcat result (princ (chr g2)))))
                        (   (= 13 g2) nil)
                        (   (= 08 g2)
                            (if (< 0 (strlen result))
                                (progn
                                    (setq result (substr result 1 (1- (strlen result))))
                                    (princ (vl-list->string '(8 32 8)))
                                )
                            )
                            t
                        )
                        (   t   )
                    )
                )
                (   (= 25 g1) nil)
                (   t   )
            )
        )
    )
    result
)





(defun LM:CurveText ( str ent / old_cmd 3pi/2 a1 a2 a3 acdoc acspc df di dr g1 g2 gr in ln lst ms obj p1 p2 p3 pi/2 ts ob_mark
                                max_space ent_length ent_close wid1 wid2
                    )

    (mini_start T)
    (setq acdoc (vla-get-activedocument (vlax-get-acad-object))
          acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace))
          ob_mark (entlast)
    )
    (or *offset* (setq *offset* 0.0))
    (or *spacin* (setq *spacin* 1.1))

    (setq
        sel (if sel (vlax-ename->vla-object sel))
        ts
         (/ (if sel (vla-get-Height sel) (getvar 'textsize))
            (if (LM:isAnnotative (getvar 'textstyle))
                (cond ((getvar 'cannoscalevalue)) ( 1.0 ))
                1.0
            )
         )
        ms (if sel (vla-get-StyleName sel) (getvar 'textstyle))
        lst (mapcar
               '(lambda ( c )
                    (setq obj (vla-addtext acspc c (vlax-3D-point (getvar 'VIEWCTR)) ts))
                    (vla-put-alignment obj acalignmentmiddlecenter)
                    (vla-put-StyleName obj ms)
                    obj
                )
                (mai_str2lst str "")
            )
        wid1 (textbox (entget (vlax-vla-object->ename (car lst))))
        wid1 (* 0.5 (- (caadr wid1) (caar wid1)))
        wid2 (textbox (entget (vlax-vla-object->ename (last lst))))
        wid2 (* 0.5 (- (caadr wid2) (caar wid2)))
        ms    (princ "\n[W/S]¼üµ÷ÕûÆ«ÒÆÖµ, [A/D]¼üµ÷Õû¼ä¾à£¬ÎÄ×ÖÎ»ÖÃ:")
        ln    (length lst)
        pi/2  (* 0.5 pi)
        3pi/2 (* 1.5 pi)
        ent_close (mai_curve_isclosed ent)
        ent_length (mai_curve_length ent)
        max_space (if ent_close
                      (/ ent_length ln)
                      (/ (- ent_length wid1 wid2) (1- ln))
                  )
        max_space (/ max_space ts)
    )
    (while
        (progn
            (setq gr (grread t 15 0)
                  g1 (car  gr)
                  g2 (cadr gr)
            )
            (cond
                (   (or (= 05 g1) (= 03 g1))
                    (setq p1 (trans g2 1 0)
                          p2 (vlax-curve-getclosestpointto ent p1)
                          dr (angle '(0.0 0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent p2)))
                          di (vlax-curve-getdistatpoint ent p2)
                          p1 (mai_point_per2line p1 p2 (polar p2 (+ dr pi/2) 5.))
                          a1 (angle p2 p1)
                          df (- a1 dr)
                          in -1
                          a2 (cond ((and (> dr pi/2) (<= dr pi)) (- pi))
                                   ((and (> dr pi) (<= dr 3pi/2)) pi)
                                   (0.0)
                             )
                          rev (and (< pi/2 dr) (<= dr 3pi/2))
                          di (if ent_close di (max di (if rev wid2 wid1)))
                          di (if ent_close di (min di (- ent_length (if rev wid1 wid2) (* (1- ln) *spacin* ts))))
                    )
                    (foreach obj (if rev (reverse lst) lst)
                        (if (setq in (1+ in)
                                  p3 (vlax-curve-getPointatDist ent (rem (+ di (* in *spacin* ts)) ent_length))
                            )
                            (progn
                                (setq a3 (angle '(0. 0. 0.) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent p3))))
                                (vla-put-TextAlignmentPoint obj (vlax-3D-point (polar p3 (+ a3 df) (* ts *offset*))))
                                (vla-put-rotation obj (+ a2 a3))
                            )
                        )
                    )
                    (= 05 g1)
                )
                (   (= 25 g1) nil)
                (   (= 02 g1)
                    (cond ((member g2 '(13 32)) nil)
                          ((member g2 '(119 87)) (setq *offset* (+ *offset* 0.1))) ;w
                          ((member g2 '(83 115)) (setq *offset* (- *offset* 0.1))) ;s
                          ((member g2 '(100 68)) (setq *spacin* (min max_space (+ *spacin* 0.05)))) ;d
                          ((member g2 '(97 65)) (setq *spacin* (max 0.05 (- *spacin* 0.05)))) ;a
                          ((princ (strcat "\n²»Ö§³Ö´Ë¼ü." ms)))
                    )
                )
                (   t  )
            )
        )        
    )
    (mai_group_creat (mai_newset ob_mark))
    (mai_end)
)



    (cond
        (   (= 4 (logand 4 (mai_dxf 70 (tblsearch "LAYER" (getvar 'CLAYER)))))
            (princ "\nµ±Ç°²ã±»Ëø¶¨.")
        )
        (   (and
                (setq sel (LM:SelectionOrText "\nÑ¡Ôñ»òÊäÈë°´ÇúÏßÅÅµÄÎÄ×Ö:" '(lambda(x)(wcmatch (mai_dxf 0 x) "*TEXT,ATTRIB"))))
                (or (and (eq 'STR (type sel))
                         (setq obj sel sel nil str obj)
                    )
                    (setq str (mai_clear_mtformat (mai_dxf 1 sel)))
                )
                (progn (if sel (redraw sel 3)) T)
                (setq obj (car (mai_entsel nil "Ñ¡Ôñ°´ÇúÏßÅÅ×ÖµÄÇúÏß:<»Ø³µÍË³ö>" "Ñ¡ÔñµÄ²»ÊÇ¶àÒåÏß¡¢Ïß¡¢Ô²»ò»¡." '((0 . "*Polyline,line,arc,circle,spline,ellipse")) nil)))
                (progn (if sel (redraw sel 4)) T)
            )
            (LM:CurveText str obj)
        )
    )
    (princ)
)
