[LISP程序]：文字齐线 [记录这一刻]

carrot1983

记录下这一刻，在晓东重生。。。
功能：文字齐线
命令：af
适用曲线LINE,ARC,CIRCLE,ELLIPSE

[PHP]
(defun c:af (/                 ang             elist         ename
             i                 pt             sscur         sstxt
             jw-angle-curvept             jw-angle-sharp
            )
  (princ "\n文字齐线 carrot1983")
  (vl-load-com)
  ;;(angtos (jw-angle-curvept (car (entsel)) (getpoint)) 0 )
  (defun jw-angle-curvept (ename pt / ang tan)
    (setq tan (vlax-curve-getfirstderiv
                ename
                (vlax-curve-getparamatpoint ename pt)
              )
    )
    (setq
      ang (if (= (car tan) 0)
            (* 0.5 pi)
            (angle (polar pt (atan (/ (cadr tan) (car tan))) 1) pt)
          )
    )
    ang
  )

  ;;(jw-angle-sharp ang)
  (defun jw-angle-sharp        (ang)
    (if        (and (> ang (* 0.5 pi)) ;_1.57
             (< ang (* 1.5 pi)) ;_4.71
        )
      (setq ang (- ang pi))
    )
    ang
  )

  (if (and (setq pt (getpoint "\n点取曲线上一点<退出>: "))
           (setq sstxt (ssget '((0 . "*TEXT"))))
      )
    (progn
      (setq sscur (ssget pt '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
      (setq ang (jw-angle-sharp (jw-angle-curvept (ssname sscur 0) pt)))
      (setq i -1)
      (repeat (sslength sstxt)
        (setq ename (ssname sstxt (setq i (+ i 1))))
        (setq elist (entget ename))
        (setq elist (subst (cons 50 ang) (assoc 50 elist) elist))
        (entmod elist)
      )
    )
  )
  (princ)
)

(princ)
[/PHP]

wuxuloveguo

支持~好东西!不过见过好象有人编辑过是先选择对象,然后把最近点打开而形成的!不过楼主的功能比较强大~

elitefish

在楼主基础上改了下，可以先选择文字
同事关闭所有捕捉仅打开最近捕捉
当然程序结束会恢复原捕捉
[PHP];==============================
;    文本相关函数
;==============================
;TextAlign 文本对齐
(defun C:TextAlign (/ ang elist ename i pt sscur sstxt  iOSMODE
                                                                        jw-angle-curvept jw-angle-sharp)
        (setq iOSMODE (getvar "OSMODE"))
        (setq olderror *error*
                *error* errorTextAlign
        )
        (setvar "OSMODE" 512)
        (princ "\n文字齐线")
        (vl-load-com)
        ;;(angtos (jw-angle-curvept (car (entsel)) (getpoint)) 0 )
        (defun jw-angle-curvept (ename pt / ang tan)
                (setq tan (vlax-curve-getfirstderiv
                                ename
                                (vlax-curve-getparamatpoint ename pt)
                                        )
                )
                (setq
                        ang (if (= (car tan) 0)
                                (* 0.5 pi)
                                (angle (polar pt (atan (/ (cadr tan) (car tan))) 1) pt)
                        )
                )
                ang
        )

        ;;(jw-angle-sharp ang)
        (defun jw-angle-sharp (ang)
                (if                (and (> ang (* 0.5 pi)) ;_1.57
                                 (< ang (* 1.5 pi)) ;_4.71
                )
                        (setq ang (- ang pi))
                )
                ang
        )

        (if         (and
                                        (progn
                                                (princ "\n选需要改变方向的文字")
                                                (setq sstxt (ssget '((0 . "*TEXT"))))
                                        )
                                        (setq pt (getpoint "\n点取需要对齐的曲线或直线上一点<退出>: "))
                        )
                (progn
                        (setq sscur (ssget pt '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
                        (setq ang (jw-angle-sharp (jw-angle-curvept (ssname sscur 0) pt)))
                        (setq i -1)
                        (repeat (sslength sstxt)
                (setq ename (ssname sstxt (setq i (+ i 1))))
                (setq elist (entget ename))
                (setq elist (subst (cons 50 ang) (assoc 50 elist) elist))
                (entmod elist)
                        )
                )
        )
        (setvar "OSMODE" iOSMODE)
(princ)
)
;出错处理
(defun errorTextAlign(msg)
        (setvar "OSMODE" iOSMODE)
        (setq *error* olderror)
)

;==============================
[/PHP]

qiuxiang129

郁闷

znchssy

不错

cq_qg68

很实用，这个程序不错，学习了。