请高手帮忙完美一下这个字对齐线么？当线竖直时候提示除数为0

tranney

有人帮忙完美一下这个字对齐线么？我一直用这个程序，但是有个小bug，当线竖直时候提示除数为0，其他的情况都很好用的，先谢谢了！
;---------- 字对齐线 开始（程序2）
;;  通用grread定义
(defun ZML-GRREAD(LST / TEST TMP MODE VAL TMP2)
    (setq TEST t)
    (while TEST
  (setq TMP  (grread 2)
        MODE (car TMP)
        VAL  (cadr TMP)
  )
  (cond ((= MODE 2)
         (if (and  (setq TMP2 (assoc MODE LST))
      (setq TMP2 (cdr TMP2))
      (setq TMP2 (assoc VAL TMP2))
       )
       (eval (cons 'progn (cdr TMP2)))
       ()
         )
        )
        ((setq TMP2 (assoc MODE LST))
         (eval (cons 'progn (cdr TMP2)))
        )
        (t (princ TMP))
  )
    )
)
;;;========================================================
;;;文字随线(角度随线的)
(vl-load-com)
(defun C:xz(/ tt-01 tt-02 LST)
    ;;===============
    ;;功能：计算计算距给定点位最近的线上点 和 线上点的前进方位角
    ;;参数：EN_LINE -----线的图元名称
    ;;           PT -----给定点位
    ;;返回：距点最近的线上点 和 线上点的方位角
    (defun TT-01 (EN_LINE PT / OBJ PT1 LST ANG)
  ;;将图元名转换为 VLA对象
  (setq OBJ (vlax-ename->vla-object EN_LINE))
  ;;距pt最近的曲线上的点pt1
  (setq PT1 (vlax-curve-getclosestpointto OBJ PT))
  ;;pt1点的切线方向矢量
  (setq LST (vlax-curve-getfirstderiv
          OBJ
          (vlax-curve-getparamatpoint
        OBJ
        PT1
          )
      )
  )
  ;;计算切线方位角
  (setq ANG (atan (/ (cadr LST) (car LST))))
  ;;返回
  (list PT1 ANG)
    )
    ;;===============
    ;;功能：设置文字对象位置及角度
    (defun TT-02 (EN_TEXT PT ANG / ENT)
  (setq ENT (entget EN_TEXT))
  (setq ENT (subst (cons 10 PT) (assoc 10 ENT) ENT)
        ENT (subst (cons 11 PT) (assoc 11 ENT) ENT)
        ENT (subst (cons 50 ANG) (assoc 50 ENT) ENT)
  )
  (entmod ENT)

    )
    ;;===============
    (if  (and
      ;;
      (setq SS (entsel "\n点取线: "))
      (setq EN_LINE (car SS))
      (setq ENT_LINE (entget EN_LINE))
      (wcmatch (cdr (assoc 0 ENT_LINE))
         "LINE,ARC,LWPOLYLINE,SPLINE"
      )
      ;;
      (setq SS (entsel "\n点取文字: "))
      (setq EN_TEXT (car SS))
      (setq ENT_TEXT (entget EN_TEXT))
      (wcmatch (cdr (assoc 0 ENT_TEXT)) "TEXT,MTEXT")

  )
  (progn
      (setq LST
         (list '(5
           ;;
           (setq
            TMP
            (TT-01 EN_LINE VAL)
            PT1
            (car TMP)
            ANG
            (cadr TMP)
           )
           ;;
           (TT-02 EN_TEXT VAL ANG)
             (vlax-get-property (vlax-ename->vla-object EN_text) 'InsertionPoint )
           ;;
           (redraw)
           (grdraw VAL PT1 1)
          )
         ;;左击
         '
          (3
           (redraw)
           (setq TEST NIL)
          )
         '(25
           (redraw)
           (setq TEST NIL)
          )
         '(11
           (redraw)
           (setq TEST NIL)
          )
         )
      )
      (ZML-GRREAD LST)
  )
    )
    (princ)
)
;---------- 字对齐线 结束

yuyehuan

功能挺好的