[求助]把文字从空格处断开自动变2行,行距由用户输入

doremidai

请高手编个程序,把文字从空格处断开自动变2行,如"KL2-22(11) 200X700",括号后为空格,从空格处把这行文字断开成2行,行距由用户输入。

doremidai

自己顶一下.

有高手编写了断开文字换行的程序，但不能连续选择.

而且不能指定行距.

sailorcwx

(defun c:strsplit(/ ACADSPC DST INDEX OBJ SLTSET STRING)
  (vl-load-com)
  (if (= (getvar "TILEMODE") 1)
    (setq acadspc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
    (setq acadspc (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object))))
    )
  (setq dst (getdist "\n输入行间距: "))
  (if (null dst)(setq dst 0))
  (while (and (setq sltset (ssget '((0 . "TEXT")))) (/= (setq string (getstring 1 "\n输入分割字符: ")) ""))
    (setq index 0)
    (repeat (sslength sltset)
      (setq obj (vlax-ename->vla-object (ssname sltset index)))
      (stringsplit obj string dst acadspc)
      (setq index (1+ index))
      )
    )
  )
 

(defun stringsplit(obj string dst acadspc / BPT BPT1 NINSERTPOINT NTEXTSTRING STRINDEX TEXTH TEXTSTRING)
  (setq bpt (vla-get-insertionpoint obj)
 bpt1 (vlax-safearray->list (vlax-variant-value bpt))
 texth (vla-get-height obj)
 )
  (vla-put-alignment obj acalignmentleft)
  (vla-put-insertionpoint obj bpt)
  (setq textstring (vla-get-textstring obj))
  (setq strindex (vl-string-search string textstring))
  (if strindex
    (progn
      (vla-put-textstring obj (substr textstring 1 strindex))
      (setq ntextstring (substr textstring (+ strindex 2))
     ninsertpoint (polar bpt1 (* 1.5 pi) (+ texth dst))
     )
      (setq obj (vla-addtext acadspc ntextstring (vlax-3d-point ninsertpoint) texth))
      (stringsplit obj string dst acadspc)
      )
    )
  )

sailorcwx

递归算法，可以连续分解

doremidai

多谢sailorcwx，高手出招。

希望做一下优化：

文字换行后样式为当前样式，能否改成与选择的文字样式和图层都相同；

另外，只能处理文字为水平（0度）的文字，如果文字是90度换行后仍然0度，且不能处理倾斜角度的文字。能否与选择文字平行？

sailorcwx

(defun c:strsplit(/ ACADSPC DST INDEX OBJ SLTSET STRING)
  (vl-load-com)
  (if (= (getvar "TILEMODE") 1)
    (setq acadspc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
    (setq acadspc (vla-get-paperspace (vla-get-activedocument (vlax-get-acad-object))))
    )
  (setq dst (getdist "\n输入行间距: "))
  (if (null dst)(setq dst 0))
  (setq string " ")
  (while (setq sltset (ssget '((0 . "TEXT"))))
    (setq index 0)
    (repeat (sslength sltset)
      (setq obj (vlax-ename->vla-object (ssname sltset index)))
      (stringsplit obj string dst acadspc)
      (setq index (1+ index))
      )
    )
  )
 

(defun stringsplit(obj string dst acadspc / BPT BPT1 NINSERTPOINT NTEXTSTRING STRINDEX TEXTH TEXTSTRING TEXTANGLE TEXTCOLOR TEXTLAYER TEXTSCALE TEXTSTYLE)
  (setq bpt (vla-get-insertionpoint obj)
 bpt1 (vlax-safearray->list (vlax-variant-value bpt))
 texth (vla-get-height obj)
 )
  (vla-put-alignment obj acalignmentleft)
  (vla-put-insertionpoint obj bpt)
  (setq textstring (vla-get-textstring obj)
 textlayer (vla-get-layer obj)
 textcolor (vla-get-color obj)
 textangle (vla-get-rotation obj)
 textstyle (vla-get-stylename obj)
 textscale (vla-get-scalefactor obj)
 )
  (setq strindex (vl-string-search string textstring))
  (if strindex
    (progn
      (vla-put-textstring obj (substr textstring 1 strindex))
      (setq ntextstring (substr textstring (+ strindex 2))
     ninsertpoint (polar bpt1 (- textangle (* 0.5 pi)) (+ texth dst))
     )
      (setq obj (vla-addtext acadspc ntextstring (vlax-3d-point ninsertpoint) texth))
      (vla-put-layer obj textlayer)
      (vla-put-color obj textcolor)
      (vla-put-rotation obj textangle)
      (vla-put-stylename obj textstyle)
      (vla-put-scalefactor obj textscale)     
      (stringsplit obj string dst acadspc)
      )
    )
  )

doremidai

多谢sailorcwx，搞定了。

向你学习。

freefeng

别分成一个一个的单词呀，最好能指定首个句子的长度。

hdlyt11

能不能不用输入行距，自动排列