小白跪求，这个调整行距程序怎么改成支持天正文字？

hyj5180 · 发表于 2018-1-17 18:05

网上找到的这个程序，原贴是2005年发布的，找不到楼主，他这个只能选择CAD单行文字“TEXT”进行调整行距，怎么简单的修改下让它能也能支持天正单行文字“TCH_TEXT”呢？在下小白，谢大神了！
；
；
；
；
；
[PHP]
(defun c:Td (/ TxtSS  L_TxtSS          ct          MY_ALL txt       FY       TH
            MY    MY_ALL ct          index  Y_min  Y_max       key       ct
            num txtEnt txt gc72 gc73       U_O       U_FX       U_FY
            U_FZ W_O NewFP  txt
            )
  (princ "\n请选择需要排列的文字:")
  (setq       TxtSS       (ssget '((0 . "TEXT")))
      L_TxtSS       (sslength TxtSS)
      ct       0
      MY_ALL       nil
  ) ;_ end of setq
  (while (< ct L_TxtSS)
(setq txt       (entget (ssname TxtSS ct))
      FY       (cadr (trans (cdr (assoc 10 txt)) 0 1))
      TH       (cdr (assoc 40 txt))
      MY       (+ FY (/ Th 2))
      MY_ALL (append MY_ALL (list MY))
      ct       (1+ ct)
)
  ) ;_ end of while
  (setq       index (vl-sort-i MY_ALL '<)
      Y_min (nth (nth 0 index) MY_ALL)
      Y_max (nth (nth (1- L_TxtSS) index) MY_ALL)
  )
  (initget 128 "S I")
  (setq
key       (getkword "\n[输入行间距(I)/根据所选文字确定行间距(S)]<S>: "
      ) ;_ end of getkword
  ) ;_ end of setq
  (if (/= key nil)
(setq key (strcase key))
  ) ;_ end of if
  (if (or (= key "S") (= key nil)) ;_ end of or
(setq deta_y (/ (- Y_max Y_min) (1- L_TxtSS)))
(if       (= key "I")
   (progn (princ "请输入行间距:") (setq deta_y (getdist))) ;_ end of progn
) ;_ end of if
  ) ;_ end of if
  (setq ct 1)
  (while (< ct L_TxtSS)
(setq num       (nth ct index)
      txtEnt (ssname TxtSS num)
      txt       (entget txtEnt)
      gc72       (cdr (assoc 72 txt))
      gc73       (cdr (assoc 73 txt))
) ;_ end of setq
(setq Y_Y (- (nth num MY_ALL) (+ y_min (* ct deta_y))) ;_ end of -
) ;_ end of setq
(if       (and (= 0 gc72) (= 0 gc73))
   (progn (setq U_O       (trans (cdr (assoc 10 txt)) 0 1)
               U_FX       (car U_O)
               U_FY       (- (cadr U_O) Y_Y)
               U_FZ       (caddr U_O)
               W_O       (trans (list U_FX U_FY U_FZ) 1 0)
               NewFP (list 10 (car W_O) (cadr W_O) (caddr W_O))
               txt       (subst NewFP (assoc 10 txt) txt)
         )
         (entmod txt)
         (entupd txtent)
   ) ;_ end of progn
   (progn (setq U_O       (trans (cdr (assoc 11 txt)) 0 1)
               U_FX       (car U_O)
               U_FY       (- (cadr U_O) Y_Y)
               U_FZ       (caddr U_O)
               W_O       (trans (list U_FX U_FY U_FZ) 1 0)
               NewFP (list 11 (car W_O) (cadr W_O) (caddr W_O))
               txt       (subst NewFP (assoc 11 txt) txt)
         )
         (entmod txt)
         (entupd txtent)
   ) ;_ end of progn
) ;_ end of if
(setq ct (1+ ct))
  ) ;_ end of while
  (princ)
) ;_ end of defun
[/PHP]

LIULISHENG · 发表于 2018-1-19 08:30

hyj5180 · 发表于 2018-1-22 12:51

顶一顶，别沉啊。。。。。。。。

ㄘ丶转裑ㄧ灬 · 发表于 2018-1-24 11:15

笨办法：先把天正文字炸一次

账号		自动登录	找回密码
密码			注册

[提问] 小白跪求，这个调整行距程序怎么改成支持天正文字？