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

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



网上找到的这个程序,原贴是2005年发布的,找不到楼主,他这个只能选择CAD单行文字“TEXT”进行调整行距,怎么简单的修改下让它能也能支持天正单行文字“TCH_TEXT”呢?在下小白,谢大神了!






(defun c:Td (/ TxtSSL_TxtSS            ct         MY_ALL txt         FY      TH
               MY   MY_ALL ct            indexY_minY_max         key      ct
               num    txtEnt txt    gc72   gc73          U_O         U_FX      U_FY
               U_FZ   W_O    NewFPtxt
            )
(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


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

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

顶一顶,别沉啊。。。。。。。。

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

笨办法:先把天正文字炸一次
页: [1]
查看完整版本: 小白跪求,这个调整行距程序怎么改成支持天正文字?