[编程申请]：请编写一个文字在空格处断开

露水2

请编写一个文字在空格处断开的lsp
例如
卧室  卫生间  餐厅  
当用lsp时使卧室是一个整体， 卫生间是一个， 餐厅是一个。

橄榄滋味

直接断开恐怕不行，不过你可以首先通过空格将不是空格的每组字符附给别的变量，然后再在相应位置创建这些字符，同时删除原先的字符即可

Free-Lancer

好像有几个工具都可以办到

露水2

其实我这里有两个文字断开的程序，一个是选择所有文字炸开后，每个文字都是独立的。
第二个是选择所有文字，然后在断开的地方点一下就会分开成两部分。
现在想要一个选择所有的文字，然后在空格处断开。

Free-Lancer

晓东工具箱中的“消除空格”是搂主要的效果吗？

doubao

2 楼的思路不错。 不过想要十分精确地把分开的字符串定位，似乎LISP有一定难度。等待高人指点，先行谢过。

cy956

最初由 doubao 发布
[B]2 楼的思路不错。 不过想要十分精确地把分开的字符串定位，似乎LISP有一定难度。等待高人指点，先行谢过。 [/B]

lisp完全做得到。要能精确定位，就要先求字串字符的位置。提供参考：

2. 
   
3. (DEFUN txt_strd(en / A D DB DB1 DB2 EN1 EN2 IN N P P0 TB TXT TXT0 TXT00 TXT01 TXTEN X1 X2)
   
4.   ;;求字串中各个字符末点，返回坐标和字表,((p1 t1)(p2 t2)....);
   
5.   (setq txt(dxf 1 en)tb(cy_str2strb txt)
   
6.         n(length tb)txt0""
   
7.         p0(dxf 10 en) a(dxf 50 en)
   
8.         in 0 db'() en2'()
   
9.         txten(cy_assoc_list en '(7 40 41 51 71 72 73))
   
10.         en1(append (list (cons 1 "0")'(50 . 0)) txten)
    
11.         db1(textbox en1)
    
12.         x1(car (cadr db1)))
    
13.   (repeat n
    
14.     (setq txt0(strcat txt0 (setq txt00(nth in tb)))in(1+ in)
    
15.           txt01(strcat txt0 "0")
    
16.           en2(append (list (cons 1 txt01)'(50 . 0)) txten)
    
17.           db2(textbox en2) x2(car (cadr db2))
    
18.           d(- x2 x1)  p(polar p0 a d)
    
19.           db(append db (list (list p txt00))))
    
20.   )db
    
21. )
    

<br /> (DEFUN txt_strd(en / A D DB DB1 DB2 EN1 EN2 IN N P P0 TB TXT TXT0 TXT00 TXT01 TXTEN X1 X2)<br />   ;;求字串中各个字符末点，返回坐标和字表,((p1 t1)(p2 t2)....);<br />   (setq txt(dxf 1 en)tb(cy_str2strb txt)<br />         n(length tb)txt0""<br />         p0(dxf 10 en) a(dxf 50 en)<br />         in 0 db'() en2'()<br />         txten(cy_assoc_list en '(7 40 41 51 71 72 73))<br />         en1(append (list (cons 1 "0")'(50 . 0)) txten)<br />         db1(textbox en1)<br />         x1(car (cadr db1)))<br />   (repeat n<br />     (setq txt0(strcat txt0 (setq txt00(nth in tb)))in(1+ in)<br />           txt01(strcat txt0 "0")<br />           en2(append (list (cons 1 txt01)'(50 . 0)) txten)<br />           db2(textbox en2) x2(car (cadr db2))<br />           d(- x2 x1)  p(polar p0 a d)<br />           db(append db (list (list p txt00))))<br />   )db<br /> )<br />

雨箭风刀

txt01(strcat txt0 "0")

每个分字加“0”, 对汉字会不会有问题？

ljpnb

试了一下，txt01(strcat txt0 "0")这句有可能应该会影响坐标位置，关键要看字体了，不同字体会有不同结果。

xyp1964

试试

2. [FONT=courier new];;;kgdk(空格断开)
   
3. (defun c:kgdk (/ ss i s1 tx len pt1 pt3 dx j site tx1 pt2)
   
4.   (CMDLA0)
   
5.   (setq        ss (ssget '((0 . "TEXT")))
   
6.         i  -1
   
7.   )
   
8.   (setvar "osmode" 0)
   
9.   (while (setq s1 (ssname ss (setq i (1+ i))))
   
10.     (setq tx  (xyp-get-dxf 1 s1)
    
11.           len (strlen tx)
    
12.           pt1 (xyp-get-minmaxpoint s1 1)
    
13.           pt3 (xyp-get-minmaxpoint s1 3)
    
14.           dx  (/ (distance pt1 pt3) len 1.0)
    
15.           j   0
    
16.     )
    
17.     (while (setq site (vl-string-search " " tx))
    
18.       (while (= (vl-string-search " " tx) 0)
    
19.         (setq tx   (substr tx 2)
    
20.               j           (1+ j)
    
21.               site (vl-string-search " " tx)
    
22.         )
    
23.       )
    
24.       (if site
    
25.         (setq tx1 (substr tx 1 site)
    
26.               tx  (substr tx (+ site 1))
    
27.         )
    
28.         (setq tx1 tx)
    
29.       )
    
30.       (setq pt2 (polar pt1 0 (* j dx)))
    
31.       (command "copy" s1 "" pt1 pt2)
    
32.       (sub_upd (entlast) 1 tx1)
    
33.       (setq j (+ j (strlen tx1)))
    
34.     )
    
35.     (entdel s1)
    
36.   )
    
37.   (CMDLA1)
    
38. )
    
39. (pxyp"kgdk  (空格断开)")
    
40. (princ)[/FONT]

[FONT=courier new];;;kgdk(空格断开)<br /> (defun c:kgdk (/ ss i s1 tx len pt1 pt3 dx j site tx1 pt2)<br />   (CMDLA0)<br />   (setq        ss (ssget '((0 . "TEXT")))<br />         i  -1<br />   )<br />   (setvar "osmode" 0)<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq tx  (xyp-get-dxf 1 s1)<br />           len (strlen tx)<br />           pt1 (xyp-get-minmaxpoint s1 1)<br />           pt3 (xyp-get-minmaxpoint s1 3)<br />           dx  (/ (distance pt1 pt3) len 1.0)<br />           j   0<br />     )<br />     (while (setq site (vl-string-search " " tx))<br />       (while (= (vl-string-search " " tx) 0)<br />         (setq tx   (substr tx 2)<br />               j           (1+ j)<br />               site (vl-string-search " " tx)<br />         )<br />       )<br />       (if site<br />         (setq tx1 (substr tx 1 site)<br />               tx  (substr tx (+ site 1))<br />         )<br />         (setq tx1 tx)<br />       )<br />       (setq pt2 (polar pt1 0 (* j dx)))<br />       (command "copy" s1 "" pt1 pt2)<br />       (sub_upd (entlast) 1 tx1)<br />       (setq j (+ j (strlen tx1)))<br />     )<br />     (entdel s1)<br />   )<br />   (CMDLA1)<br /> )<br /> (pxyp"kgdk  (空格断开)")<br /> (princ)[/FONT]

雪山飞狐(lzh)

Public Sub TextExplodeBySpace()

Dim obj As AcadEntity, pnt
Dim str As String

ThisDrawing.Utility.GetEntity obj, pnt
inspt = obj.InsertionPoint
polarPnt = ThisDrawing.Utility.PolarPoint(inspt, obj.Rotation + Atn(1) * 2, obj.Height)
str = Replace(obj.TextString, " ", "\H1X \H1X")
str = "{\W" & obj.ScaleFactor & "X;" & str & "}"
Set oMtext = ThisDrawing.ModelSpace.AddMText(polarPnt, 0, str)
oMtext.Height = obj.Height
oMtext.Rotation = obj.Rotation
oMtext.StyleName = obj.StyleName
obj.Delete
ThisDrawing.SendCommand "Explode" & vbCr & "l" & vbCr & vbCr
End Sub

以前“陌生人”的文字水平分解的程序，改动了一下
支持有宽度比例的Text（以前的程序不行：））
原理很简单，就是把Text字符改为有格式的Mtext，再炸开，你可以自己把代码移植到Lisp

露水2

忘了和大家说了
我用的是天正二和r14
前一段时间用了天正六和2002
后来的觉的做方案还是二好一些
xyp1964  你有个程序是图纸写字，我在2002中也用了
在天正里也有的只要在存放文字的文件里写出来房间名称就可以了。
例如我把住宅中的房间名称写在一起，调出来就是所以的房间名称，现在需要的就是我上面介绍的程序。你门的程序在2002可以的，但是在r14中就不可以了，还得麻烦你们。

xyp1964

不支持R14，因为不会编！呵呵……

露水2

最初由 xyp1964 发布
[B]不支持R14，不会！呵呵…… [/B]

在2002中可以就是我要的结果
但是在r14中不可以的。
哈哈