cad字体批量打断lisp_怎么将CAD里的文字打断成单个单个的

手动的话就不说了，用程序来解决是最好的办法：

(defun C:tes ( / #g1 &k1 &kw1 &ob1 &ss1 c1 c10 c40 c41 c50 c51 c7 c8 cd1 cd2 i n n1) (if (null vlax-dump-object) (vl-load-com) ) (princ "\n请选择要变为单词的文字");如果选择了，那么就把文字分开了。 (if (setq &kw1 (ssget '((0 . "TEXT")))) (progn (while (setq &k1 (ssname &kw1 0)) (setq &kw1 (ssdel &k1 &kw1) #g1 (entget &k1) cd1 (caadr (textbox #g1))) (setq &ob1 (vlax-ename->vla-object &k1)) (setq c1 (vla-get-TextString &ob1) n (strlen c1) &ss1 (lsp201510027 c1)) (setq c8 (vla-get-layer &ob1) c40 (vla-get-Height &ob1)) (setq c10 (Vlax-SafeArray->List (Vlax-Variant-Value (vla-get-InsertionPoint &ob1)))) (setq c50 (vla-get-Rotation &ob1) c7 (vla-get-StyleName &ob1) c41 (vla-get-ScaleFactor &ob1)) (setq c51 (vla-get-ObliqueAngle &ob1)) (if (> n 0) (progn;;1 (setq cd1 (/ cd1 n) i 0) (repeat (length &ss1) (setq c1 (nth i &ss1) i (1+ i) n1 (car c1) c1 (cadr c1) cd2 (* n1 cd1)) (entmake (list '(0 . "TEXT") (cons 1 c1) (cons 40 c40) (cons 41 c41) (cons 10 c10) (cons 7 c7) (cons 8 c8) (cons 50 c50) (cons 51 c51))) (setq c10 (polar c10 c50 cd2)) );repeat (vla-delete &ob1) );progn;1 );if;1 );while ) ) (princ));;文字内容拆开(defun lsp201510027 (c1 / ac2 n1 ss1) (setq ss1 '()) (while (/= c1 "") (setq ac2 (substr c1 1 1) n1 (ascii ac2)) (cond ((< n1 128) (setq c1 (substr c1 2) ac2 (list 1 ac2)) ) ((>= n1 128) (setq ac2 (substr c1 1 2) c1 (substr c1 3) ac2 (list 2 ac2))) ) (setq ss1 (cons ac2 ss1)) );while (reverse ss1));复制到记事本,以【.lsp】为后缀命名,打开CAD，autolisp加载，命令【TES】;文字分为单词

取消

评论