获得标注文字。求修改

湜１只鱼

;从标注文字中获得值，见附图。
(defun C:SD ()
(setq ssmp (ssget '((0 . "DIMENSION"))))
(setq n 0)
(if (null ssmp)
(exit)
)
(repeat (sslength ssmp)
(setq entmp (ssname ssmp n))
(setq dxfmp (entget entmp))
(setq bzzmp (assoc 1 dxfmp))
(setq bzmp (cdr bzzmp))
(vl-string-position (ascii "-") bzmp nil t)
(setq WH-kd (substr bzmp 1 (vl-string-position (ascii "-") bzmp nil t)) )
)
(SETQ PT1 (GETPOINT))
(command "text" "j" "bl" pt1 100 WH-kd)
)
;求高人帮忙改下 若标注文字里面没有“-”字符自动取消命令

ZZXXQQ

1. (defun C:SD ()
   
2. (if (setq ssmp (ssget '((0 . "DIMENSION") (1 . "*-*")))) (progn
   
3.   (setq n 0)
   
4.   (repeat (sslength ssmp)
   
5.    (setq entmp (ssname ssmp n))
   
6.    (setq dxfmp (entget entmp))
   
7.    (setq bzzmp (assoc 1 dxfmp))
   
8.    (setq bzmp (cdr bzzmp))
   
9.    (vl-string-position (ascii "-") bzmp nil t)
   
10.    (setq WH-kd (substr bzmp 1 (vl-string-position (ascii "-") bzmp nil t)) )
    
11.   )
    
12.   (SETQ PT1 (GETPOINT))
    
13.   (command "text" "j" "bl" pt1 100 WH-kd)
    
14. ))
    
15. (princ)
    
16. )
    

(defun C:SD ()<br /> (if (setq ssmp (ssget '((0 . "DIMENSION") (1 . "*-*")))) (progn<br />   (setq n 0)<br />   (repeat (sslength ssmp)<br />    (setq entmp (ssname ssmp n))<br />    (setq dxfmp (entget entmp))<br />    (setq bzzmp (assoc 1 dxfmp))<br />    (setq bzmp (cdr bzzmp))<br />    (vl-string-position (ascii "-") bzmp nil t)<br />    (setq WH-kd (substr bzmp 1 (vl-string-position (ascii "-") bzmp nil t)) )<br />   )<br />   (SETQ PT1 (GETPOINT))<br />   (command "text" "j" "bl" pt1 100 WH-kd)<br /> ))<br /> (princ)<br /> )<br />

yjr111

献丑！我来个可以多选的

2. (defun C:SD ()
   
3. (setvar "cmdecho" 0)
   
4. (setq n 0 mp t lst_bzmp '())
   
5. (setq height1 (getvar "dimtxt"))
   
6. (setq ssmp (ssget '((0 . "DIMENSION"))))
   
7.   (while (and ( < n (sslength ssmp)) mp)
   
8.     (setq s1 (entget (setq e1 (ssname ssmp n ))))
   
9.                (setq bzmp (cdr (assoc 1 s1)))
   
10.                
    
11.                (if (= bzmp "")
    
12.         (setq bzmp (vl-princ-to-string (cdr (assoc 42 s1))))
    
13.       )
    
14.   (if (setq location (vl-string-search "-"  bzmp ))
    
15.       (progn
    
16.       (setq bzmp (substr bzmp 1 location))
    
17.       (setq  lst_bzmp(reverse(cons bzmp (reverse lst_bzmp))))
    
18.       
    
19.     )
    
20.     (progn
    
21.     (princ"\n 没有带“-”的标注文字!")
    
22.     (setq mp nil)
    
23.     )
    
24.     )
    
25.     (setq n (1+ n))
    
26.    
    
27.   )
    
28. (if location(progn
    
29.   (SETQ PT1 (GETPOINT"\n 请选择插入点："))
    
30.   (setq height (getdist"\n 请输入文字高度<右键默认标注字高>:"))
    
31.    (if (not height)(setq height height1))
    
32.   (if (> (sslength ssmp) 1)(progn
    
33.    (setq WBJULI (getdist"\n 请输入文字行间距<1.4>:"))
    
34.     (if (not WBJULI)(setq WBJULI (* height 1.4)))
    
35.    ))
    
36.   (foreach x lst_bzmp (setq  bzmp x)
    
37.   (command "text" "j" "bl" pt1 height "" bzmp)
    
38.    (command )
    
39.     (setq pt1 (list (car pt1)(- (cadr pt1) WBJULI) (caddr pt1)))
    
40.    
    
41.   )))
    
42.   (princ)
    
43.   )
    

(defun C:SD ()<br /> (setvar "cmdecho" 0)<br /> (setq n 0 mp t lst_bzmp '())<br /> (setq height1 (getvar "dimtxt"))<br /> (setq ssmp (ssget '((0 . "DIMENSION"))))<br />   (while (and ( < n (sslength ssmp)) mp) <br />     (setq s1 (entget (setq e1 (ssname ssmp n ))))<br />                (setq bzmp (cdr (assoc 1 s1)))<br />                <br />                (if (= bzmp "")<br />         (setq bzmp (vl-princ-to-string (cdr (assoc 42 s1))))<br />       )<br />   (if (setq location (vl-string-search "-"  bzmp ))<br />       (progn<br />       (setq bzmp (substr bzmp 1 location))<br />       (setq  lst_bzmp(reverse(cons bzmp (reverse lst_bzmp))))<br />       <br />     )<br />     (progn<br />     (princ"\n 没有带“-”的标注文字!")<br />     (setq mp nil)<br />     )<br />     )<br />     (setq n (1+ n))<br />     <br />   )<br /> (if location(progn<br />   (SETQ PT1 (GETPOINT"\n 请选择插入点："))<br />   (setq height (getdist"\n 请输入文字高度<右键默认标注字高>:"))<br />    (if (not height)(setq height height1))<br />   (if (> (sslength ssmp) 1)(progn<br />    (setq WBJULI (getdist"\n 请输入文字行间距<1.4>:"))<br />     (if (not WBJULI)(setq WBJULI (* height 1.4)))<br />    ))<br />   (foreach x lst_bzmp (setq  bzmp x)<br />   (command "text" "j" "bl" pt1 height "" bzmp)<br />    (command )<br />     (setq pt1 (list (car pt1)(- (cadr pt1) WBJULI) (caddr pt1))) <br />    <br />   )))<br />   (princ)<br />   )<br />

湜１只鱼

谢谢各位了  呵呵……