[LISP函数]：文字拆分lsp程序

jiega · 发表于 2005-11-6 10:30:33

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

[php](defun tiao ()
  (setq ang1 (atan y x))
  (setq d (distance pt pt1))
  (setq pt1 (polar pt (+ ang ang1) d))
)

(defun nextt (n /)
  (setq post (+ post n))
  (if (= hsc 0.8)
(setq pt (polar pt angle_ (* distxt 0.9)))
(setq pt (polar pt angle_ distxt))
  )
)

(defun C:exstr (/ stye lay ent sel    el layt  sty txt    pt
   high scale angle_    ang post  distxt    stxt
   dx dy dxx dyy    pt1 p    txt1  stxt1 ang1
   x y    n
   )
  (setq stye (getvar "textstyle"))
  (setq lay (getvar "clayer"))
  (setvar "CMDECHO" 0)
  (setq ent (car (entsel "\n选择文字:<Exit>")))
  (if (/= ent nil)
(progn
   (setq sel (entget ent))
   (if (= "TEXT" (cdr (assoc 0 sel)))
(progn
   (setq el (cdr (assoc -1 sel)))
   (command "erase" el "")
   (setq layt (cdr (assoc 8 sel)))
   (setq sty (cdr (assoc 7 sel)))
   (setq txt (cdr (assoc 1 sel)))
   (setq pt (cdr (assoc 10 sel)))
   (setq high (cdr (assoc 40 sel)))
   (setq scale (cdr (assoc 41 sel)))
   (setq angle_ (cdr (assoc 50 sel)))
   (setq ang (/ (* angle_ 180) pi))
   (setq post 1)

   (setq distxt (* high scale))
   (princ
      (strcat "\n文字间隔 : <" (rtos distxt 2 3) ">")
   )
   (setq distxt (getreal))
   (if (= distxt nil)
      (setq distxt (* high scale))
   )

   (command "style" sty "" "0" scale "0" "" "" "")
   (command "layer" "s" layt "")

   (setq p 1) ;
   (setq hsc 1) ;
   (setq txt1 (substr txt p 1)) ; 判断文字串中
   (repeat (strlen txt) ; 是否有汉字,
      (if (> (ascii txt1) 160)
      (setq hsc 0.8)
      ) ;; 汉字ASCII大
      (setq p (1+ p)) ;; 于160
      (setq txt1 (substr txt p 1)) ;
   ) ;

   (setq stxt nil)
   (while (/= stxt "")
      (setq stxt (substr txt post 1))

      (if (<= (ascii stxt) 160)
      ;;  文字是西文
      (progn
(setq dx (car pt))
(setq dy (cadr pt))

;;  处理以%开始的扩展字符
(cond ((= (ascii stxt) 37) ;  文字是: %
         (progn
   (setq stxt1 (substr txt (+ post 1) 1))
   (if (= (ascii stxt1) 37)
   ;;判断下一个文字是否也是: %
   (progn
      (setq stxt (substr txt post 5))
      (if (= hsc 0.8)
         (progn
   (setq x (* high 0.188))
   (setq dxx (+ dx x))
   (setq y (* high scale 0.1))
   (setq dyy (+ dy y))
         )
         (progn
   (setq dxx dx)
   (setq dyy dy)
         )
      )
      (setq pt1 (list dxx dyy))
      ;;(if (= hsc 0.8) (tiao)) ;如果有汉字, 调整pt1
      (command "text" pt1 (* high hsc) ang stxt)
      (nextt 5)
   )

   (progn
      (if (= hsc 0.8)
         (progn
   (setq x (* high 0.188))
   (setq dxx (+ dx x))
         )
         (setq dxx dx)
      )
      (if (= hsc 0.8)
         (progn
   (setq y (* high scale 0.1))
   (setq dyy (+ dy y))
         )
         (setq dyy dy)
      )
      (setq pt1 (list dxx dyy))
;                   (if (= hsc 0.8) (tiao)) ;如果有汉字, 调整pt1
      (command "text" pt1 (* high hsc) ang stxt)
      (nextt 1)
   )
   )
         )
      )
;  处理以%开始的扩展字符结束
;  处理其它的字母和数字
      (T
         (progn
   (if (= hsc 0.8)
   (progn
      (setq x (* high 0.188))
      (setq dxx (+ dx x))
   )
   (setq dxx dx)
   )
   (if (= hsc 0.8)
   (progn
      (setq y (* high scale 0.1))
      (setq dyy (+ dy y))
   )
   (setq dyy dy)
   )
   (setq pt1 (list dxx dyy))
   (if (= hsc 0.8)
   (tiao)
   ) ;如果有汉字, 调整pt1
   (command "text" pt1 (* high hsc) ang stxt)
   (nextt 1)
         )
      )
;  处理其它的字母和数字结束
)
      )
;  处理汉字
      (progn
(setq stxt (substr txt post 2))
(command "text" pt high ang stxt)
(setq post (+ post 2))
(setq pt (polar pt angle_ distxt))
      )
;  处理汉字结束

      )
   )
   (command "style" stye "" "" "" "" "" "" "")
   (command "layer" "s" lay "")
   (redraw)
)
(princ "\nObject is not a TEXT !")
   )
)
  )
  (princ)
)[/php]

tang84 · 发表于 2005-11-11 17:48:17

自动增有吗

地鼠 · 发表于 2005-11-13 13:54:42

好用。已收藏，不过如果支持多行文字就更好了。希望楼主改改

xjlmlxbq · 发表于 2005-11-14 21:07:22

楼主有没有文字连接？

乌龙大虾 · 发表于 2005-12-13 19:06:43

文字连接tssd里面有，但是不知道怎么写的，多谢楼主。

jiega · 发表于 2005-12-13 19:26:28

合并字符串(源码)
http://www.xdcad.net/forum/showthread.php?s=&threadid=496860
修改文字高度(源码)
http://www.xdcad.net/forum/showthread.php?s=&threadid=496855
修改、统一字体(源码)
http://www.xdcad.net/forum/showthread.php?s=&threadid=496858

125740513 · 发表于 2006-6-7 21:44:29

ok
谢谢
又一个问题解决了

海豚 · 发表于 2006-6-10 09:40:22

我觉得这样自动拆分为单个文字的作用不大，但单论拆分的效果，还是不错的。部分“％％数字”的间距有小问题。

lizuizui · 发表于 2006-6-10 16:58:52

感觉意义并不是太大，文字拆分只是偶尔为之，不需要这么麻烦

qiaqiadeng · 发表于 2006-8-5 12:06:25

多谢楼主,最近正在研究一个用地着的超级命令,终于搜到了.

ynjzlzd · 发表于 2006-10-20 13:25:39

要是能随意按字的个数拆分就好了.

ucsicon · 发表于 2006-10-20 23:43:38

还不知道怎么用，先下着，谢谢了

有点小烦 · 发表于 2006-10-24 15:52:28

权当是一中LISP的练习吧！

wuqing1999 · 发表于 2006-11-11 10:21:39

我加载后怎么不能实现呢,怎么个用法?

qiaqiadeng · 发表于 2007-1-3 09:21:40

用处不是太大,建议大家搜索我的一个文字拆分程序,比较有用.

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

[LISP函数]：文字拆分lsp程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

浏览过的版块