回复 Gu_xl 的帖子
Gu_xl 大师你好，我的意思是 ：在动态切换标注样式的程序中加一个功能，当切换到想要的标注样式后（确认后），就把切换到的标注样式置为当前使用的标注样式。再次感谢你的热情帮助！
不错！学习了
((= 13 (cadr gr)) (setq loop nil)(command "dimstyle" "r" style) )
回复 zhynt 的帖子
非常感谢zhynt大师的帮助。
我把它加在 (princ))之前，效果可以达到了！
只是出现一个不影响程序使用的错误：“$2”？？？ ; 错误: no function definition: nil
((= 13 (cadr gr)) (setq loop nil) (command "dimstyle" "r" style))
(princ))
只要添加 (command "dimstyle" "r" style) 就可以了！
谢谢两位大师！
本帖最后由 raimo 于 2011-7-14 22:54 编辑
可以用鼠标中键(滚轮)切换吗?
raimo 发表于 2011-7-14 22:52 static/image/common/back.gif
可以用鼠标中键(滚轮)切换吗?
是啊 这个好像更方便 好想法啊
669423907 发表于 2011-7-11 23:00 static/image/common/back.gif
想请高手们帮忙写一个动态切换标注样式的程序，不知是否能达到以下效果：
已有标注样式：5,7,10,13,15,1 ...
非常有创意的程序，GOODidea
顺问下 用的GG录屏吗 很清晰
本帖最后由 cumtjh 于 2011-7-15 14:22 编辑
;;;动态切换标注样式的程序，搞机械的很实用啊！（感谢Gu_xl 版主完美解决）
;;;http://bbs.mjtd.com/forum.php?mod=viewthread&tid=88162&fromuid=269329
;作者:By Gu_xl 版主(感谢669423907提出好点子 )
;;整理:By cumtjh
;;待改进 为支持鼠标中键切换标注就更帅啦
;;根据此程序可以做动态缩放等 一些动态命令 值得推荐
(defun c:tabdim (/ loop i ss dimstyles gr cnt)
(setq dimstyles (vl-sort (gxl-table "dimstyle") '(lambda (a b) (> (atoi a) (atoi b))))
cnt (length dimstyles)
i -1
loop t
)
(setq ss (ssget '((0 . "DIMENSION"))))
(if ss
(progn
(princ "\n*** 键入 A 或 S 切换标注样式 ， 回车键或右键结束 *** ")
(princ "\n")
(while loop
(setq gr (grread t 5 1))
(if (= 2 (car gr))
(cond ((or (= 97 (cadr gr)) (= 65 (cadr gr)))
(setq i (1+ i)
i (rem i cnt)
)
(setq style (nth i dimstyles))
(princ (strcat "\r***当前标注样式为: " style " "))
(gxl-sel-mapcar ss '(lambda (x) (GXL-CH_ENT x 3 style)))
)
((or (= 83 (cadr gr)) (= 115 (cadr gr)))
(setq i (1- i))
(if (MINUSP i) (setq i (+ i cnt)))
(setq style (nth i dimstyles))
(princ (strcat "\r***当前标注样式为: " style " "))
(gxl-sel-mapcar ss '(lambda (x) (GXL-CH_ENT x 3 style)))
)
((= 13 (cadr gr)) (setq loop nil))
) ;_ cond
(if (= 25 (car gr))
(setq loop nil)
)
)
)
)
)
(command "dimstyle" "r" style);切换到的标注样式置为当前使用的标注样式
(princ (strcat "\r***当前切换标注样式为: " style " "))
(princ)
)
;;;gxl-table 返回包含在指定符号表中的所有元素
(defun gxl-table (s / d r)
(while (setq d (tblnext s (null d)))
(setq r (cons (cdr (assoc 2 d)) r))
)
)
;;;(gxl-CH_Ent ent i pt) 用新值pt更新图元ent索引i对应的值
(defun gxl-CH_Ent (ent i pt / en)
(if (assoc i (setq en (entget ent)))
(setq en (subst (cons i pt) (assoc i en) en))
(setq en (append en (list (cons i pt))))
)
(entmod en)
)
;;;(gxl-Sel-Mapcar ss Fun) 遍历选择集对所包含的图元进行指定函数操作,返回操作后的表
(defun gxl-Sel-Mapcar (ss Fun / nn rtn)
(repeat (setq nn (sslength ss))
(setq rtn (cons (apply Fun (list (ssname ss (setq nn (1- nn))))) rtn))
)
)
不错,下来学习.