[LISP程序]：文本字符串的"拉伸"

lsjjm

文本字符串的"拉伸"
[php]
(defun lenstr (ss)
  (setq tst (textbox (list (cons 1 ss))))
  (setq l (car (cadr tst)))
)
;
(defun c:test (/ ll lst)
  (setq a (car (entsel)))
  (setq el (entget a))
  (setq p (cdr (assoc 10 el)))
  (setq p1 (getpoint p "\nSpecify End Point: "))
  (setq str (cdr (assoc 1 el)))
  (setq l0 (lenstr str))
  (setq lst (mapcar 'chr (vl-string->list str)))
  (setq clay (getvar "clayer"))
  (setq csty (getvar "textstyle"))
  (setvar "textstyle" (cdr (assoc 7 el)))
  (repeat (strlen str)
    (if (> (strlen str) 1)
      (setq g2 (lenstr (substr str 2 1))
            ll (cons (- (lenstr (substr str 1 2)) g2) ll))
    )
    (setq str (substr str 2))
  )
  (setq d (/ (- (distance p1 p) l0)(length ll)))
  (vl-cmdf "layer" "s" (cdr (assoc 8 (entget a))) "")
  (vl-cmdf "erase" a "")
  (setq n 0)
  (while (< n (length lst))
    (vl-cmdf "text" p (cdr (assoc 40 el)) (* (/ 180 pi)(cdr (assoc 50 el)))(nth n lst) "")
    (setq p (polar p (cdr (assoc 50 el)) (+ (nth n (reverse ll)) d)))
    (setq n (1+ n))
  )
  (setvar "textstyle" csty)
  (setvar "clayer" clay)
)
[/php]

陌生人

提两条：
1。不支持汉字，测试中汉字全部丢失
2。undo不能一步复原

lhj743

不但丢失汉字，
剩下的数字被变得一个一个的！

lsjjm

我的CAD系统是英文的. 平常也没有机会处理中文字符. 程序嘛就是个思路, 自己改改.