帮忙加个框选吧，网上的程序，在这谢谢原作者。

freeok

帮忙加个框选吧，网上的程序，在这谢谢原作者。
如有冒犯，敬请原谅！！！
;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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:exs(/ stye lay ss en 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)
(prompt "\n选择文本")
(setq ss (ssget))
(setq i 0)
  (repeat (sslength ss)
  (setq en (ssname ss i))
  (setq ent (car en))
(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 "\nDistance between TEXT : <" (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)
        (setq i (1+ i))
      )
      (princ "\nObject is not a TEXT !")
      )
    )
  )
  (princ)
)

USER2128

请说明一下，该程序是用来干什么的，你想达到什么要求！

freeok

USER2128 发表于 2012-11-17 14:22
请说明一下，该程序是用来干什么的，你想达到什么要求！

您好！终于有侠来了，呵呵。
这是一个炸开字串的程序，原程序只单选，我试着框选，可加不出来。
希望有大侠帮把手。谢谢。

USER2128

你贴出来的程序本身就有错，改进了错误后发现，不能“批选”是因捕捉打开了的原因。
现上传给你完整程序

x_s_s_1

freeok 发表于 2012-11-17 14:29
您好！终于有侠来了，呵呵。
这是一个炸开字串的程序，原程序只单选，我试着框选，可加不出来。
...

您那个代码不全，没去测试，搞了个没处理特殊字符的，您自己改改，您的原意是炸成线吧，打散一个命令就可以复原，搞结构就搞结构，琢磨这些歪门邪道干什么

2. ;;; &&&&&&&&&&开始创建单行文字函数&&&&&&&&&&
   
3. ;;; 参数：l_n------图层名(字符串)
   
4. ;;;      t_10------第一对齐点，如t_72或t_73非零，则该值忽略(点)
   
5. ;;;      t_t------文字本身(字符串)
   
6. ;;;      t_h------文字高度(整型)
   
7. ;;;      t_w------宽度因子(实型)
   
8. ;;;      t_st------文字样式(字符串)
   
9. ;;;      t_50------倾斜角度(整型)
   
10. ;;;      t_72------水平文字对正类型
    
11. ;;;      t_73-------垂直文字对正类型
    
12. ;;;      t_11------第二对齐点，如t_72和t_73为零，则该值忽略(点)
    
13. (defun t_mak (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)
    
14.   (entmake (list '(0 . "text")
    
15.                  '(100 . "AcDbEntity")
    
16.                  (cons 8 l_n)
    
17.                  '
    
18.                   (100 . "AcDbText")
    
19.                  (cons 10 t_10)
    
20.                  (cons 1 t_t)
    
21.                  (cons 40 t_h)
    
22.                  (cons 41 t_w)
    
23.                  (cons 7 t_st)
    
24.                  (cons 72 t_72)
    
25.                  (cons 11 t_11)
    
26.                  (cons 50 t_50)
    
27.                  (cons 73 t_73)
    
28.            )                                ; _ 结束list
    
29.   )                                        ; _ 结束entmake
    
30. 
    
31. )
    
32. ;;; _ 结束defun
    
33. ;;;by bbs.mjtd.com TANER
    
34. (defun str2celst (str / i lst n stri)
    
35.   (setq i 1
    
36. n (strlen str)
    
37.   )
    
38.   (while (<= i n)
    
39.     (setq stri (substr str i 1))
    
40.     (if (> (ascii stri) 159)
    
41.       (setq stri (substr str i 2)
    
42.      i  (+ i 2)
    
43.      lst  (cons stri lst)
    
44.       )
    
45.       (setq stri (substr str i 1)
    
46.      i  (1+ i)
    
47.      lst  (cons stri lst)
    
48.       )
    
49.     )
    
50.     (reverse lst)
    
51.   )
    
52. )
    
53. (defun ent_t_lst(en / l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st t_lst i n)
    
54. (setq l_n (cdr (assoc 8(entget en)))
    
55.       t_10 (cdr (assoc 10(entget en)))
    
56.       t_11 '(0 0 0)
    
57.       t_t(cdr (assoc 1(entget en)))
    
58.       t_50(cdr (assoc 50(entget en)))
    
59.       t_72 0
    
60.       t_73 0
    
61.       t_h (cdr (assoc 40(entget en)))
    
62.       t_w (cdr (assoc 41(entget en)))
    
63.       t_st (cdr (assoc 7(entget en)))
    
64.       t_lst(str2celst t_t)
    
65.       i 0
    
66.       n (length t_lst)
    
67.       )
    
68. (while (< i n)
    
69.   (t_mak l_n t_10 t_11 (nth i t_lst) t_50 t_72 t_73 t_h t_w t_st)
    
70.   (setq i (1+ i) t_10 (polar t_10 t_50 (* t_h t_w 1.27)))
    
71.         )
    
72. )
    
73. (defun x_ssn (ss / n lst)
    
74.   (repeat (setq N (sslength ss))
    
75.     (setq LST (cons (ssname SS (setq N (1- N))) LST))
    
76.   )
    
77. )
    
78. (defun c:test1 (/)
    
79.   (mapcar '(lambda (x) (ent_t_lst x) (entdel x))
    
80.           (x_ssn (ssget '((0 . "text"))))
    
81.   )
    
82. )

;;; &&&&&&&&&&开始创建单行文字函数&&&&&&&&&&<br /> ;;; 参数：l_n------图层名(字符串)<br /> ;;;      t_10------第一对齐点，如t_72或t_73非零，则该值忽略(点)<br /> ;;;      t_t------文字本身(字符串)<br /> ;;;      t_h------文字高度(整型)<br /> ;;;      t_w------宽度因子(实型)<br /> ;;;      t_st------文字样式(字符串)<br /> ;;;      t_50------倾斜角度(整型)<br /> ;;;      t_72------水平文字对正类型<br /> ;;;      t_73-------垂直文字对正类型<br /> ;;;      t_11------第二对齐点，如t_72和t_73为零，则该值忽略(点)<br /> (defun t_mak (l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st /)<br />   (entmake (list '(0 . "text")<br />                  '(100 . "AcDbEntity")<br />                  (cons 8 l_n)<br />                  '<br />                   (100 . "AcDbText")<br />                  (cons 10 t_10)<br />                  (cons 1 t_t)<br />                  (cons 40 t_h)<br />                  (cons 41 t_w)<br />                  (cons 7 t_st)<br />                  (cons 72 t_72)<br />                  (cons 11 t_11)<br />                  (cons 50 t_50)<br />                  (cons 73 t_73)<br />            )                                ; _ 结束list<br />   )                                        ; _ 结束entmake<br /> <br /> )<br /> ;;; _ 结束defun<br /> ;;;by bbs.mjtd.com TANER<br /> (defun str2celst (str / i lst n stri)<br />   (setq i 1<br /> n (strlen str)<br />   )<br />   (while (<= i n)<br />     (setq stri (substr str i 1))<br />     (if (> (ascii stri) 159)<br />       (setq stri (substr str i 2)<br />      i  (+ i 2)<br />      lst  (cons stri lst)<br />       )<br />       (setq stri (substr str i 1)<br />      i  (1+ i)<br />      lst  (cons stri lst)<br />       )<br />     )<br />     (reverse lst)<br />   )<br /> )<br /> (defun ent_t_lst(en / l_n t_10 t_11 t_t t_50 t_72 t_73 t_h t_w t_st t_lst i n)<br /> (setq l_n (cdr (assoc 8(entget en)))<br />       t_10 (cdr (assoc 10(entget en)))<br />       t_11 '(0 0 0)<br />       t_t(cdr (assoc 1(entget en)))<br />       t_50(cdr (assoc 50(entget en)))<br />       t_72 0<br />       t_73 0<br />       t_h (cdr (assoc 40(entget en)))<br />       t_w (cdr (assoc 41(entget en)))<br />       t_st (cdr (assoc 7(entget en)))<br />       t_lst(str2celst t_t)<br />       i 0<br />       n (length t_lst)<br />       )<br /> (while (< i n)<br />   (t_mak l_n t_10 t_11 (nth i t_lst) t_50 t_72 t_73 t_h t_w t_st)<br />   (setq i (1+ i) t_10 (polar t_10 t_50 (* t_h t_w 1.27)))<br />         )<br /> )<br /> (defun x_ssn (ss / n lst)<br />   (repeat (setq N (sslength ss))<br />     (setq LST (cons (ssname SS (setq N (1- N))) LST))<br />   )<br /> )<br /> (defun c:test1 (/)<br />   (mapcar '(lambda (x) (ent_t_lst x) (entdel x))<br />           (x_ssn (ssget '((0 . "text"))))<br />   )<br /> )

freeok

USER2128 发表于 2012-11-17 15:31
你贴出来的程序本身就有错，改进了错误后发现，不能“批选”是因捕捉打开了的原因。
现上传给你完整程序

因捕捉打开的原因，这个会影响到框选不能进行吗？谢谢！

USER2128

freeok 发表于 2012-11-17 22:09
因捕捉打开的原因，这个会影响到框选不能进行吗？谢谢！

给你的程序可以一次选择一批，在程序执行过程中，注意看状态行，（多回几次车）让程序执行完

freeok

x_s_s_1 发表于 2012-11-17 16:27
您那个代码不全，没去测试，搞了个没处理特殊字符的，您自己改改，您的原意是炸成线吧，打散一个命令就可 ...

谢谢您的程序！
不过我只是想达到自己的使用效果。
向前辈致敬！