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

669423907

回复 Gu_xl 的帖子

Gu_xl 大师你好，我的意思是 ：在动态切换标注样式的程序中加一个功能，当切换到想要的标注样式后（确认后），就把切换到的标注样式置为当前使用的标注样式。再次感谢你的热情帮助！

xiaotao

不错！学习了

zhynt

((= 13 (cadr gr)) (setq loop nil)  (command "dimstyle" "r" style) )

669423907

回复 zhynt 的帖子

非常感谢zhynt大师的帮助。


我把它加在 (princ))之前，效果可以达到了！



只是出现一个不影响程序使用的错误：“$2”？？？           ; 错误: no function definition: nil
((= 13 (cadr gr)) (setq loop nil) (command "dimstyle" "r" style))
(princ))

669423907

只要添加   (command "dimstyle" "r" style)   就可以了！
谢谢两位大师！

raimo

可以用鼠标中键(滚轮)切换吗?

cumtjh

raimo 发表于 2011-7-14 22:52
可以用鼠标中键(滚轮)切换吗?

是啊 这个好像更方便 好想法啊

cumtjh

669423907 发表于 2011-7-11 23:00
想请高手们帮忙写一个动态切换标注样式的程序，不知是否能达到以下效果：
已有标注样式：  5,7,10,13,15,1 ...

非常有创意的程序，GOODidea
顺问下 用的GG录屏吗 很清晰

cumtjh

2. 
   
3. 
   
4. ;;;动态切换标注样式的程序，搞机械的很实用啊！（感谢Gu_xl 版主完美解决）
   
5. ;;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=88162&fromuid=269329
   
6. ;作者:By Gu_xl 版主(感谢669423907提出好点子 )
   
7. ;;整理:By cumtjh
   
8. ;;待改进 为支持鼠标中键切换标注就更帅啦
   
9. ;;根据此程序可以做动态缩放等 一些动态命令 值得推荐
   
10. 
    
11. (defun c:tabdim (/ loop i ss dimstyles gr cnt)
    
12.   (setq dimstyles (vl-sort (gxl-table "dimstyle") '(lambda (a b) (> (atoi a) (atoi b))))
    
13.         cnt (length dimstyles)
    
14.         i -1
    
15.         loop t
    
16.         )
    
17.   (setq ss (ssget '((0 . "DIMENSION"))))
    
18.   (if ss
    
19.     (progn
    
20.       (princ "\n*** 键入 A 或 S 切换标注样式 ， 回车键或右键结束 *** ")
    
21.       (princ "\n")
    
22.       (while loop
    
23.         (setq gr (grread t 5 1))
    
24.         (if (= 2 (car gr))
    
25.         (cond ((or (= 97 (cadr gr)) (= 65 (cadr gr)))
    
26.                (setq i (1+ i)
    
27.                      i (rem i cnt)
    
28.                      )
    
29.                (setq style (nth i dimstyles))
    
30.                (princ (strcat "\r***当前标注样式为: " style "                                     "))
    
31.                (gxl-sel-mapcar ss '(lambda (x) (GXL-CH_ENT x 3 style)))
    
32.                )
    
33.               ((or (= 83 (cadr gr)) (= 115 (cadr gr)))
    
34.                (setq i (1- i))
    
35.                 (if (MINUSP i) (setq i (+ i cnt)))   
    
36.                (setq style (nth i dimstyles))
    
37.                (princ (strcat "\r***当前标注样式为: " style "                                     "))
    
38.                (gxl-sel-mapcar ss '(lambda (x) (GXL-CH_ENT x 3 style)))
    
39.                )
    
40.               ((= 13 (cadr gr)) (setq loop nil))
    
41.               ) ;_ cond
    
42.           (if (= 25 (car gr))
    
43.             (setq loop nil)
    
44.             )
    
45.           )
    
46.         )
    
47.       
    
48.       )
    
49.     )
    
50.     (command "dimstyle" "r" style);切换到的标注样式置为当前使用的标注样式
    
51.     (princ (strcat "\r***当前切换标注样式为: " style "                                     "))
    
52.     (princ)
    
53.   )
    
54. ;;;gxl-table 返回包含在指定符号表中的所有元素
    
55. (defun gxl-table (s / d r)
    
56.   (while (setq d (tblnext s (null d)))
    
57.     (setq r (cons (cdr (assoc 2 d)) r))
    
58.   )
    
59. )
    
60. ;;;(gxl-CH_Ent ent i pt) 用新值pt更新图元ent索引i对应的值
    
61. (defun gxl-CH_Ent (ent i pt / en)
    
62.   (if (assoc i (setq en (entget ent)))
    
63.     (setq en (subst (cons i pt) (assoc i en) en))
    
64.     (setq en (append en (list (cons i pt))))
    
65.     )
    
66.     (entmod en)
    
67.   )
    
68. ;;;(gxl-Sel-Mapcar ss Fun) 遍历选择集对所包含的图元进行指定函数操作,返回操作后的表
    
69. (defun gxl-Sel-Mapcar (ss Fun / nn rtn)
    
70.   (repeat (setq nn (sslength ss))
    
71.   (setq rtn (cons (apply Fun (list (ssname ss (setq nn (1- nn))))) rtn))
    
72.     )
    
73.   )
    

<br /> <br /> ;;;动态切换标注样式的程序，搞机械的很实用啊！（感谢Gu_xl 版主完美解决）<br /> ;;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=88162&fromuid=269329<br /> ;作者:By Gu_xl 版主(感谢669423907提出好点子 )<br /> ;;整理:By cumtjh <br /> ;;待改进 为支持鼠标中键切换标注就更帅啦<br /> ;;根据此程序可以做动态缩放等 一些动态命令 值得推荐<br /> <br /> (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 />     (command "dimstyle" "r" style);切换到的标注样式置为当前使用的标注样式<br />     (princ (strcat "\r***当前切换标注样式为: " style "                                     "))<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 />

T_T

不错,下来学习.