[求助]：如何改变ssget的提示词？

x99

把my-ssget修改如下就可以了：

(DEFUN my-ssget (str lst / ss)
  (IF (OR (= str nil) (= str ""))
    (PRINC "\n选择对象：")
    (PRINC (STRCAT "\n" str))
  )
  (SETVAR "nomutt" 1)
  (SETQ ss (VL-CATCH-ALL-APPLY 'SSGET (list lst)))
  (SETVAR "nomutt" 0)
  (IF (VL-CATCH-ALL-ERROR-P ss)
    nil
    ss
  )
)

另外后面主程序的（setvar "nomutt" )语句可以全部删除。否则有点画蛇添足。

eobser

谢谢！
已经可以了。

zml84

2007-03-07：[/COLOR]
对eobser同学在15楼的代码，根据我的理解改动后如下：
[PHP]
;;;主程序
;;;=================================
(defun c:gjcd ()
    (setvar "nomutt" 0)
    (setvar "cmdecho" 0)
    (setq odim (getvar "dimzin"))
    (setvar "dimzin" 1)
    (setq ortho (getvar "orthomode"))
    (setvar "orthomode" 1)
    (if        (setq ss1 (my-ssget "请选择第一列乘数(单长):" '((0 . "*TEXT"))))
        (if (setq ss2 (my-ssget "请选择第二列乘数(根数):" '((0 . "*TEXT"))))
            (if        (= (setq ss1n (sslength ss1)) (setq ss2n (sslength ss2)))
                (progn
                    (princ (strcat ">>>>>>选择了 " (itoa ss1n) " 对数据。"))
                    (if        (setq ent_f (getreal "\n输入小数点位数<2>:"))
                        ()
                        (setq ent_f 2)
                    )
                    (setq pt1 (getpoint "\n选择基点:"))
                    (setq ent1 (entlast))
                    (command "copy" ss2 "" pt1 pause)
                    (setq ss3 (ssadd))
                    (while (setq ent1 (entnext ent1))
                        (ssadd ent1 ss3)
                    )
                    (setq htxt (cdr (assoc 40 (entget (ssname ss1 0)))))
                    (setq i 0)
                    (repeat (min ss1n ss2n)
                        (setq ent3 (entget (ssname ss3 i)))
                        (setq y3 (caddr (assoc 10 ent3)))
                        (setq ii 0)
                        (repeat        ss1n
                            (if        (< (abs        (- y3
                                           (caddr
                                               (assoc
                                                   10
                                                   (entget (ssname ss1 ii))
                                               )
                                           )
                                        )
                                   )
                                   htxt
                                )
                                (setq text1
                                         (atof
                                             (cdr
                                                 (assoc        1
                                                        (entget (ssname ss1 ii))
                                                 )
                                             )
                                         )
                                )
                            )
                            (if        (< (abs        (- y3
                                           (caddr
                                               (assoc
                                                   10
                                                   (entget (ssname ss2 ii))
                                               )
                                           )
                                        )
                                   )
                                   htxt
                                )
                                (setq text2
                                         (atof
                                             (cdr
                                                 (assoc        1
                                                        (entget (ssname ss2 ii))
                                                 )
                                             )
                                         )
                                )
                            )
                            (setq ii (1+ ii))
                        )
                        (setq text3
                                 (rtos (/ (* text1 text2) 1000) 2 (fix ent_f))
                        )
                        (setq ent3
                                 (subst (cons 1 text3) (assoc 1 ent3) ent3)
                        )
                        (entmod ent3)
                        (setq i (1+ i))
                    )
                )
                (alert (princ "\n\"单长\"与\"根数\"不一样多。"))
            )
        )
    )
    (setvar "dimzin" odim)
    (setvar "orthomode" ortho)
    (princ)
)
;;;=================================
[/PHP]

2007-04-06添加：[/COLOR]
下面这个函数是仿SSGET函数的，在选择过程中可以显示当前选择状态。
希望大家完善之。

2. 
   
3. ;;;功能：通用函数 my-ssget
   
4. ;;;简介：仿SSGET函数(自定义SSGET函数的提示内容，选择过程中显示当前状态。)
   
5. ;;;日期：zml84 于 2007-04-06
   
6. ;;;=====================================================
   
7. (DEFUN my-ssget        (str lst / old-nomutt ss)
   
8.     (IF        (OR (= str nil) (= str ""))
   
9.         (PRINC "\n选择对象：")
   
10.         (PRINC (STRCAT "\n" str))
    
11.     )
    
12.     (SETQ old-nomutt (GETVAR "nomutt"))
    
13.     (SETVAR "nomutt" 1)
    
14.     (SETQ ss (VL-CATCH-ALL-APPLY 'SSGET (list lst)))
    
15.     (SETVAR "nomutt" old-nomutt)
    
16.     (IF        (VL-CATCH-ALL-ERROR-P ss)
    
17.         nil
    
18.         ss
    
19.     )
    
20. )
    
21. ;;;=====================================================
    
22. ;;;函数定义
    
23. (DEFUN my-ssget        (str lst / old-nomutt ss)
    
24.     (IF        (OR (= str nil) (= str ""))
    
25.         (SETQ str "\n选择对象：")
    
26.         (SETQ str (STRCAT "\n" str))
    
27.     )
    
28.     (SETQ old-nomutt (GETVAR "nomutt"))
    
29. ;;;    (SETVAR "nomutt" 1)
    
30.     (SETQ ss   (ssadd)
    
31.           test T
    
32.     )
    
33.     (WHILE test
    
34.         (PRINC str)
    
35.         (setq temp-ss nil)
    
36.         (INITGET "W L C ALL F P")
    
37.         (IF (SETQ temp (VL-CATCH-ALL-APPLY 'GETPOINT))
    
38.             (progn
    
39.                 (cond
    
40.                     ((listp temp)
    
41.                      (setq pt1 temp)
    
42.                      (if (ssget pt1)
    
43.                          (setq temp-ss (ssget pt1 lst))
    
44.                          (if (setq pt2 (getcorner pt1 "指定对角点:"))
    
45.                              (if (> (car pt2) (car pt1))
    
46.                                  (setq temp-ss (ssget "W" pt1 pt2 lst))
    
47.                                  (setq temp-ss (ssget "C" pt1 pt2 lst))
    
48.                              )
    
49.                          )
    
50.                      )
    
51.                     )
    
52. 
    
53. 
    
54.                     ;;窗口(W)
    
55.                     ((= temp "W")
    
56.                      (if (setq pt1 (getpoint "\n指定第一个角点: "))
    
57.                          (if (setq pt2 (getcorner pt1 "指定对角点:"))
    
58.                              (setq temp-ss (ssget "W" pt1 pt2 lst))
    
59.                          )
    
60.                      )
    
61.                     )
    
62. 
    
63. ;;;                    ;;上一个(L)
    
64. ;;;                    ;;★★未完成
    
65. ;;;                    ((= temp "L")
    
66. ;;;                     (if (entlast)
    
67. ;;;                         (setq temp-ss (ssget "l" lst))
    
68. ;;;                         (princ "没有上一个选择集。")
    
69. ;;;                     )
    
70. ;;;                    )
    
71. 
    
72.                     ;;窗交(C)
    
73.                     ((= temp "C")
    
74.                      (if (setq pt1 (getpoint "\n指定第一个角点: "))
    
75.                          (if (setq pt2 (getcorner pt1 "指定对角点:"))
    
76.                              (setq temp-ss (ssget "C" pt1 pt2 lst))
    
77.                          )
    
78.                      )
    
79.                     )
    
80. 
    
81.                     ;;全部(ALL)
    
82.                     ((= temp "ALL")
    
83.                      (setq temp-ss (ssget "all" lst))
    
84.                     )
    
85. 
    
86.                     ;;栏选(F)
    
87.                     ((= temp "F")
    
88.                      (setq l '())
    
89.                      (while (if        (= (length l) 0)
    
90.                                 (setq pt (getpoint "\n指定第一个栏选点:")
    
91.                                 )
    
92.                                 (progn
    
93.                                     (initget "U")
    
94.                                     (setq pt (getpoint
    
95.                                                  (car l)
    
96.                                                  "\n指定下一个栏选点或 [放弃(U)]:"
    
97.                                              )
    
98.                                     )
    
99.                                 )
    
100.                             )
     
101. 
     
102.                          ;;对用户输入进行响应
     
103.                          (cond
     
104.                              ((= pt "U")
     
105.                               (setq l (cdr l))
     
106.                              )
     
107.                              ((listp pt)
     
108.                               (setq
     
109.                                   l (cons (list (car pt) (cadr pt)) l)
     
110.                               )
     
111.                              )
     
112.                          )
     
113.                          ;;绘出迹线
     
114.                          (if (>= (length l) 2)
     
115.                              (grdraw (cadr l) (car l) 2 1)
     
116.                          )
     
117.                      )
     
118.                      ;;将点位表进行倒置（也可以不作）
     
119.                      (setq l (reverse l))
     
120.                      (if (> (length l) 1)
     
121.                          (setq temp-ss (ssget "F" l lst))
     
122.                      )
     
123.                     )
     
124. 
     
125. ;;;                    ;;前一个(P)
     
126. ;;;                    ;;★★未完成
     
127. ;;;                    ((= temp "P")
     
128. ;;;                     (if (ssget "P")
     
129. ;;;                         (setq temp-ss (ssget "P"))
     
130. ;;;                         (princ "没有前一个选择集。")
     
131. ;;;                     )
     
132. ;;;                    )
     
133. 
     
134.                     ;;拦截处理
     
135.                     (T
     
136.                      (princ
     
137.                          (strcat
     
138.                              "\n*无效选择*"
     
139.                              "\n需要点或窗口(W)/上一个(L)/窗交(C)/框(BOX)"
     
140.                              "/全部(ALL)/栏选(F)/圈围(WP)/圈交(CP)/编组(G)"
     
141.                              "/添加(A)/删除(R)/多个(M)/前一个(P)/放弃(U)"
     
142.                              "/自动(AU)/单个(SI)")
     
143.                      )
     
144.                     )
     
145.                 )                        ; 结束cond
     
146. 
     
147.                 (setq n-old (sslength ss))
     
148.                 (if temp-ss
     
149.                     (progn
     
150.                         ;;计算找到数量
     
151.                         (setq n-temp (sslength temp-ss)
     
152.                               i             0
     
153.                         )
     
154.                         ;;将temp-ss添加到SS中并高亮显示
     
155.                         (repeat        n-temp
     
156.                             (setq ei (ssname temp-ss i)
     
157.                                   ss (ssadd ei ss)
     
158.                             )
     
159.                             (redraw ei 3)
     
160.                             (setq i (1+ i))
     
161.                         )
     
162.                         ;;计算总计数量和重复数量
     
163.                         (setq n-ss   (sslength ss)
     
164.                               n-重复 (- (+ n-old n-temp) n-ss)
     
165.                         )
     
166.                     )
     
167.                     (setq n-temp 0
     
168.                           n-重复 0
     
169.                           n-ss n-old
     
170.                     )
     
171.                 )
     
172.                 ;;输出找到数量
     
173.                 (princ (strcat " 找到 "
     
174.                                (itoa n-temp)
     
175.                                " 个"
     
176.                        )
     
177.                 )
     
178.                 ;;输出重复数量
     
179.                 (if (> n-重复 0)
     
180.                     (princ (strcat " ("
     
181.                                    (itoa n-重复)
     
182.                                    " 个重复)"
     
183.                            )
     
184.                     )
     
185.                 )
     
186.                 ;;输出总计数量
     
187.                 (if (= n-old 0)
     
188.                     ()
     
189.                     (princ (strcat
     
190.                                "，总计 "
     
191.                                (itoa n-ss)
     
192.                                " 个"
     
193.                            )
     
194.                     )
     
195.                 )
     
196.             )                                ; 结束progn
     
197.             (setq test nil)
     
198.         )                                ; 结束if
     
199.         (if (VL-CATCH-ALL-ERROR-P temp)
     
200.             (setq test nil)
     
201.         )
     
202.     )                                        ; 结束while
     
203. 
     
204.     ;;恢复设置
     
205.     (SETVAR "nomutt" old-nomutt)
     
206.     ss
     
207. )
     
208. ;;;=====================================================
     

<br /> ;;;功能：通用函数 my-ssget<br /> ;;;简介：仿SSGET函数(自定义SSGET函数的提示内容，选择过程中显示当前状态。)<br /> ;;;日期：zml84 于 2007-04-06<br /> ;;;=====================================================<br /> (DEFUN my-ssget        (str lst / old-nomutt ss)<br />     (IF        (OR (= str nil) (= str ""))<br />         (PRINC "\n选择对象：")<br />         (PRINC (STRCAT "\n" str))<br />     )<br />     (SETQ old-nomutt (GETVAR "nomutt"))<br />     (SETVAR "nomutt" 1)<br />     (SETQ ss (VL-CATCH-ALL-APPLY 'SSGET (list lst)))<br />     (SETVAR "nomutt" old-nomutt)<br />     (IF        (VL-CATCH-ALL-ERROR-P ss)<br />         nil<br />         ss<br />     )<br /> )<br /> ;;;=====================================================<br /> ;;;函数定义<br /> (DEFUN my-ssget        (str lst / old-nomutt ss)<br />     (IF        (OR (= str nil) (= str ""))<br />         (SETQ str "\n选择对象：")<br />         (SETQ str (STRCAT "\n" str))<br />     )<br />     (SETQ old-nomutt (GETVAR "nomutt"))<br /> ;;;    (SETVAR "nomutt" 1)<br />     (SETQ ss   (ssadd)<br />           test T<br />     )<br />     (WHILE test<br />         (PRINC str)<br />         (setq temp-ss nil)<br />         (INITGET "W L C ALL F P")<br />         (IF (SETQ temp (VL-CATCH-ALL-APPLY 'GETPOINT))<br />             (progn<br />                 (cond<br />                     ((listp temp)<br />                      (setq pt1 temp)<br />                      (if (ssget pt1)<br />                          (setq temp-ss (ssget pt1 lst))<br />                          (if (setq pt2 (getcorner pt1 "指定对角点:"))<br />                              (if (> (car pt2) (car pt1))<br />                                  (setq temp-ss (ssget "W" pt1 pt2 lst))<br />                                  (setq temp-ss (ssget "C" pt1 pt2 lst))<br />                              )<br />                          )<br />                      )<br />                     )<br /> <br /> <br />                     ;;窗口(W)<br />                     ((= temp "W")<br />                      (if (setq pt1 (getpoint "\n指定第一个角点: "))<br />                          (if (setq pt2 (getcorner pt1 "指定对角点:"))<br />                              (setq temp-ss (ssget "W" pt1 pt2 lst))<br />                          )<br />                      )<br />                     )<br /> <br /> ;;;                    ;;上一个(L)<br /> ;;;                    ;;★★未完成<br /> ;;;                    ((= temp "L")<br /> ;;;                     (if (entlast)<br /> ;;;                         (setq temp-ss (ssget "l" lst))<br /> ;;;                         (princ "没有上一个选择集。")<br /> ;;;                     )<br /> ;;;                    )<br /> <br />                     ;;窗交(C)<br />                     ((= temp "C")<br />                      (if (setq pt1 (getpoint "\n指定第一个角点: "))<br />                          (if (setq pt2 (getcorner pt1 "指定对角点:"))<br />                              (setq temp-ss (ssget "C" pt1 pt2 lst))<br />                          )<br />                      )<br />                     )<br /> <br />                     ;;全部(ALL)<br />                     ((= temp "ALL")<br />                      (setq temp-ss (ssget "all" lst))<br />                     )<br /> <br />                     ;;栏选(F)<br />                     ((= temp "F")<br />                      (setq l '())<br />                      (while (if        (= (length l) 0)<br />                                 (setq pt (getpoint "\n指定第一个栏选点:")<br />                                 )<br />                                 (progn<br />                                     (initget "U")<br />                                     (setq pt (getpoint<br />                                                  (car l)<br />                                                  "\n指定下一个栏选点或 [放弃(U)]:"<br />                                              )<br />                                     )<br />                                 )<br />                             )<br /> <br />                          ;;对用户输入进行响应<br />                          (cond<br />                              ((= pt "U")<br />                               (setq l (cdr l))<br />                              )<br />                              ((listp pt)<br />                               (setq<br />                                   l (cons (list (car pt) (cadr pt)) l)<br />                               )<br />                              )<br />                          )<br />                          ;;绘出迹线<br />                          (if (>= (length l) 2)<br />                              (grdraw (cadr l) (car l) 2 1)<br />                          )<br />                      )<br />                      ;;将点位表进行倒置（也可以不作）<br />                      (setq l (reverse l))<br />                      (if (> (length l) 1)<br />                          (setq temp-ss (ssget "F" l lst))<br />                      )<br />                     )<br /> <br /> ;;;                    ;;前一个(P)<br /> ;;;                    ;;★★未完成<br /> ;;;                    ((= temp "P")<br /> ;;;                     (if (ssget "P")<br /> ;;;                         (setq temp-ss (ssget "P"))<br /> ;;;                         (princ "没有前一个选择集。")<br /> ;;;                     )<br /> ;;;                    )<br /> <br />                     ;;拦截处理<br />                     (T<br />                      (princ<br />                          (strcat<br />                              "\n*无效选择*"<br />                              "\n需要点或窗口(W)/上一个(L)/窗交(C)/框(BOX)"<br />                              "/全部(ALL)/栏选(F)/圈围(WP)/圈交(CP)/编组(G)"<br />                              "/添加(A)/删除(R)/多个(M)/前一个(P)/放弃(U)"<br />                              "/自动(AU)/单个(SI)")<br />                      )<br />                     )<br />                 )                        ; 结束cond<br /> <br />                 (setq n-old (sslength ss))<br />                 (if temp-ss<br />                     (progn<br />                         ;;计算找到数量<br />                         (setq n-temp (sslength temp-ss)<br />                               i             0<br />                         )<br />                         ;;将temp-ss添加到SS中并高亮显示<br />                         (repeat        n-temp<br />                             (setq ei (ssname temp-ss i)<br />                                   ss (ssadd ei ss)<br />                             )<br />                             (redraw ei 3)<br />                             (setq i (1+ i))<br />                         )<br />                         ;;计算总计数量和重复数量<br />                         (setq n-ss   (sslength ss)<br />                               n-重复 (- (+ n-old n-temp) n-ss)<br />                         )<br />                     )<br />                     (setq n-temp 0<br />                           n-重复 0<br />                           n-ss n-old<br />                     )<br />                 )<br />                 ;;输出找到数量<br />                 (princ (strcat " 找到 "<br />                                (itoa n-temp)<br />                                " 个"<br />                        )<br />                 )<br />                 ;;输出重复数量<br />                 (if (> n-重复 0)<br />                     (princ (strcat " ("<br />                                    (itoa n-重复)<br />                                    " 个重复)"<br />                            )<br />                     )<br />                 )<br />                 ;;输出总计数量<br />                 (if (= n-old 0)<br />                     ()<br />                     (princ (strcat<br />                                "，总计 "<br />                                (itoa n-ss)<br />                                " 个"<br />                            )<br />                     )<br />                 )<br />             )                                ; 结束progn<br />             (setq test nil)<br />         )                                ; 结束if<br />         (if (VL-CATCH-ALL-ERROR-P temp)<br />             (setq test nil)<br />         )<br />     )                                        ; 结束while<br /> <br />     ;;恢复设置<br />     (SETVAR "nomutt" old-nomutt)<br />     ss<br /> )<br /> ;;;=====================================================<br />

2. 
   
3. ;;;测试
   
4. (defun c:tt ()
   
5.     ;;(setq s1 (my-ssget ">>>>>文字:" '((0 . "*TEXT"))))
   
6.     (setq s1 (my-ssget ">>>>>请选择直线:" '((0 . "*LINE"))))
   
7.     ;;(setq s1 (my-ssget ">>>>>请任意选择:" nil))
   
8.     (command "_regenall")
   
9.     (princ "\n正常结束。")
   
10.     (princ)
    
11. )
    
12. ;;;=====================================================
    

<br /> ;;;测试<br /> (defun c:tt ()<br />     ;;(setq s1 (my-ssget ">>>>>文字:" '((0 . "*TEXT"))))<br />     (setq s1 (my-ssget ">>>>>请选择直线:" '((0 . "*LINE"))))<br />     ;;(setq s1 (my-ssget ">>>>>请任意选择:" nil))<br />     (command "_regenall")<br />     (princ "\n正常结束。")<br />     (princ)<br /> )<br /> ;;;=====================================================<br />