动态切换标注样式的程序，搞机械的很实用啊！（感谢Gu_xl 版主完美解决）

669423907

想请高手们帮忙写一个动态切换标注样式的程序，不知是否能达到以下效果：
已有标注样式：  5,7,10,13,15,18,20,23,26,28,30,35,40,45,50,55,60,65,70,80,90,100,120,150.....200....230.....570....2300.....5000.....

1：已有以数字开头（整数）的标注样式十几个（或更多）；
2：先选择多个标注样式，按下快捷键A，就把被选中的标注样式改变为下个以数字开头更大的标注样式，
      并动态显示改变后的效果；
3：如果一直按着A，就不停地切换，直到切换到最大的那个标注样式就停下来，右键确定并退出
4：一直按着S键，就以反方向不停地切换，直到切换到最小的那个标注样式就停下来，右键确定并退出
5：过程中可以随时按A或S，右键确定并退出
不知论坛的大师们认为此程序是否可行？！


;保留标注样式的PU
(defun c:pu()
(setvar "clayer""0")
(command "purge" "la" "" "n" ""  "purge" "lt" "" "n" "" "purge" "r" "" "n" ""
"purge" "b" "" "n" "" "purge" "p" "" "n" "" "purge" "st" "" "n" "" )
(princ))

Gu_xl

回复 669423907 的帖子

1. (defun c:tabdim (/ loop i ss dimstyles gr cnt)
   
2.   (setq dimstyles (vl-sort (gxl-table "dimstyle") '(lambda (a b) (> (atoi a) (atoi b))))
   
3.         cnt (length dimstyles)
   
4.         i -1
   
5.         loop t
   
6.         )
   
7.   (setq ss (ssget '((0 . "DIMENSION"))))
   
8.   (if ss
   
9.     (progn
   
10.       (princ "\n*** 键入 A 或 S 切换标注样式 ， 回车键或右键结束 *** ")
    
11.       (princ "\n")
    
12.       (while loop
    
13.         (setq gr (grread t 5 1))
    
14.         (if (= 2 (car gr))
    
15.         (cond ((or (= 97 (cadr gr)) (= 65 (cadr gr)))
    
16.                (setq i (1+ i)
    
17.                      i (rem i cnt)
    
18.                      )
    
19.                (setq style (nth i dimstyles))
    
20.                (princ (strcat "\r***当前标注样式为: " style "                                     "))
    
21.                (gxl-sel-mapcar ss '(lambda (x) (GXL-CH_ENT x 3 style)))
    
22.                )
    
23.               ((or (= 83 (cadr gr)) (= 115 (cadr gr)))
    
24.                (setq i (1- i))
    
25.                 (if (MINUSP i) (setq i (+ i cnt)))   
    
26.                (setq style (nth i dimstyles))
    
27.                (princ (strcat "\r***当前标注样式为: " style "                                     "))
    
28.                (gxl-sel-mapcar ss '(lambda (x) (GXL-CH_ENT x 3 style)))
    
29.                )
    
30.               ((= 13 (cadr gr)) (setq loop nil))
    
31.               ) ;_ cond
    
32.           (if (= 25 (car gr))
    
33.             (setq loop nil)
    
34.             )
    
35.           )
    
36.         )
    
37.       
    
38.       )
    
39.     )
    
40.     (princ)
    
41.   )
    
42. ;;;gxl-table 返回包含在指定符号表中的所有元素
    
43. (defun gxl-table (s / d r)
    
44.   (while (setq d (tblnext s (null d)))
    
45.     (setq r (cons (cdr (assoc 2 d)) r))
    
46.   )
    
47. )
    
48. ;;;(gxl-CH_Ent ent i pt) 用新值pt更新图元ent索引i对应的值
    
49. (defun gxl-CH_Ent (ent i pt / en)
    
50.   (if (assoc i (setq en (entget ent)))
    
51.     (setq en (subst (cons i pt) (assoc i en) en))
    
52.     (setq en (append en (list (cons i pt))))
    
53.     )
    
54.     (entmod en)
    
55.   )
    
56. ;;;(gxl-Sel-Mapcar ss Fun) 遍历选择集对所包含的图元进行指定函数操作,返回操作后的表
    
57. (defun gxl-Sel-Mapcar (ss Fun / nn rtn)
    
58.   (repeat (setq nn (sslength ss))
    
59.   (setq rtn (cons (apply Fun (list (ssname ss (setq nn (1- nn))))) rtn))
    
60.     )
    
61.   )
    
62. 
    

(defun c:tabdim (/ loop i ss dimstyles gr cnt)<br />   (setq dimstyles (vl-sort (gxl-table "dimstyle") '(lambda (a b) (> (atoi a) (atoi b))))<br />         cnt (length dimstyles)<br />         i -1<br />         loop t<br />         )<br />   (setq ss (ssget '((0 . "DIMENSION"))))<br />   (if ss<br />     (progn<br />       (princ "\n*** 键入 A 或 S 切换标注样式 ， 回车键或右键结束 *** ")<br />       (princ "\n")<br />       (while loop<br />         (setq gr (grread t 5 1))<br />         (if (= 2 (car gr))<br />         (cond ((or (= 97 (cadr gr)) (= 65 (cadr gr)))<br />                (setq i (1+ i)<br />                      i (rem i cnt)<br />                      )<br />                (setq style (nth i dimstyles))<br />                (princ (strcat "\r***当前标注样式为: " style "                                     "))<br />                (gxl-sel-mapcar ss '(lambda (x) (GXL-CH_ENT x 3 style)))<br />                )<br />               ((or (= 83 (cadr gr)) (= 115 (cadr gr)))<br />                (setq i (1- i))<br />                 (if (MINUSP i) (setq i (+ i cnt)))    <br />                (setq style (nth i dimstyles))<br />                (princ (strcat "\r***当前标注样式为: " style "                                     "))<br />                (gxl-sel-mapcar ss '(lambda (x) (GXL-CH_ENT x 3 style)))<br />                )<br />               ((= 13 (cadr gr)) (setq loop nil))<br />               ) ;_ cond<br />           (if (= 25 (car gr))<br />             (setq loop nil)<br />             )<br />           )<br />         )<br />       <br />       )<br />     )<br />     (princ)<br />   )<br /> ;;;gxl-table 返回包含在指定符号表中的所有元素<br /> (defun gxl-table (s / d r)<br />   (while (setq d (tblnext s (null d)))<br />     (setq r (cons (cdr (assoc 2 d)) r))<br />   )<br /> )<br /> ;;;(gxl-CH_Ent ent i pt) 用新值pt更新图元ent索引i对应的值<br /> (defun gxl-CH_Ent (ent i pt / en)<br />   (if (assoc i (setq en (entget ent)))<br />     (setq en (subst (cons i pt) (assoc i en) en))<br />     (setq en (append en (list (cons i pt))))<br />     )<br />     (entmod en)<br />   )<br /> ;;;(gxl-Sel-Mapcar ss Fun) 遍历选择集对所包含的图元进行指定函数操作,返回操作后的表<br /> (defun gxl-Sel-Mapcar (ss Fun / nn rtn)<br />   (repeat (setq nn (sslength ss))<br />   (setq rtn (cons (apply Fun (list (ssname ss (setq nn (1- nn))))) rtn))<br />     )<br />   )<br /> <br />

大西瓜

加载插件，测试标注样式可以切换，但对于全局比例不为1的样式会失效。全局比例没有随标注样式同步更新，所有看到标注大小有时候没有变化

大西瓜

诺捷铝板插件中，有个快捷键切换标注样式的功能用的是Gu_xl版主的代码

669423907

非常有创意的程序啊，哪位大师帮帮忙啦！

669423907

回复 Gu_xl 的帖子

非常感谢 Gu_xl大师的热情帮助！
现在用手机上，晚上再下！
再次感谢Gu_xl大师！

zhynt

是可以实现的
一个例子：

2. 
   
3. (defun c:tt ()
   
4.   (setq aaa T)
   
5.   (setq n 1)
   
6.   (setq nmin 1)
   
7.   (setq nmax 10)
   
8.   (while AAA
   
9.     (setq code (grread))
   
10.     (setq id (cadr code))
    
11.     (cond ((or (= id 97) (= id 63))
    
12.            (if (= n nmax)
    
13.              (prompt "\n已经到头了!!!")
    
14.              (progn (prompt (strcat "\n当前值为" (rtos n)))
    
15.                     (setq n (1+ n))
    
16.              )
    
17.            )
    
18.           )
    
19.           ((or (= id 115) (= id 83))
    
20.            (if (= n nmin)
    
21.              (princ "\n已经到头了!!!")
    
22.              (progn (princ (strcat "\n当前值为" (rtos n)))
    
23.                     (setq n (1- n))
    
24.              )
    
25.            )
    
26.           )
    
27.           ((or (= id 122) (= id 90)) (SETQ AAA NIL))
    
28.     )
    
29.   )
    
30. )
    

<br /> (defun c:tt ()<br />   (setq aaa T)<br />   (setq n 1)<br />   (setq nmin 1)<br />   (setq nmax 10)<br />   (while AAA<br />     (setq code (grread))<br />     (setq id (cadr code))<br />     (cond ((or (= id 97) (= id 63))<br />            (if (= n nmax)<br />              (prompt "\n已经到头了!!!")<br />              (progn (prompt (strcat "\n当前值为" (rtos n)))<br />                     (setq n (1+ n))<br />              )<br />            )<br />           )<br />           ((or (= id 115) (= id 83))<br />            (if (= n nmin)<br />              (princ "\n已经到头了!!!")<br />              (progn (princ (strcat "\n当前值为" (rtos n)))<br />                     (setq n (1- n))<br />              )<br />            )<br />           )<br />           ((or (= id 122) (= id 90)) (SETQ AAA NIL))<br />     )<br />   )<br /> )<br />

a----->加
s----->减
z----->退出

634074698

  好东东

669423907

回复 Gu_xl 的帖子

效果相当好！程序非常给力！
非常感谢Gu_xl版主！

669423907

回复 zhynt 的帖子

请问zhynt大师，你的程序是控制那个变量或者什么东东的呢？
既然可以用 “Z” 退出，那是不是也可以用一个 ？？？变量？代码？.....代替 “Esc” ？
我想在每天第一次启动 CAD (加载完所有外挂后) 时向 CAD 发送一个“Esc”，去掉一个外挂的弹出框。不知可否？

669423907

回复 Gu_xl 的帖子

请问Gu_xl大师，方不方便加一个功能，把选择要用的标注样式置为当前呢？这样就不用再次选标注样式了。非常感谢你。

Gu_xl

(command "dimstyle" "r" 标注样式名称)