[求助]快速修改尺寸显示精度？
本论坛上没有见到如何修改尺寸显示精度，请教各位有没有好方法？我想了下，写了如下的LISP,供你参考！
(DEFUN C:JD (/ v1 v2 jd ss s1 en_data nx ) ;更改尺寸精度的程序
(setvar "cmdecho" 0)
(SETQ V1 (GETVAR "DIMDEC"))
(setq v2 (getvar "dimstyle"))
(SETQ JD (GETREAL "\n=>输入精度小数位数<0>:!"))
(IF (OR (= JD nil) (= jd ""))
(setq jd 0)
)
(princ "\n=>请框选需要加改变精度的尺寸")
(setq ss (ssget '((0 . "DIMENSION")))
i-1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq en_data (entget s1))
(setq edimsy(cdr(assoc 3 en_data)))
(command "-dimstyle" "r" edimsy )
(setq nx (cdr (assoc 70 en_data)))
(if (or (= nx 163) (= nx 164))
(setvar "dimtoh" 1)
)
(if (= nx 162)
(progn (setvar "dimtoh" 1)
(setvar "dimtih" 1)
)
)
(setvar "dimdec" jd)
(setvar "dimadec" jd)
(command "-dimstyle" "a" s1 "")
)
(setvar "dimdec" v1)
(command "-dimstyle" "r" v2)
(princ)
) 其实一个命令就可以 aidimprec
谢谢分享 这样的好工具 http://bbs.mjtd.com/forum.php?mod=viewthread&tid=89353 本帖最后由 自贡黄明儒 于 2011-12-17 16:52 编辑
;;;感谢duotu007
;;;结合两人的程序，我试了一下，很方便的
;;; 模仿动态右键菜单-----by caoyin 2011.11.29
;;; -------------------------------------------------------------
;;; 以前我们实现右键菜单是在菜单文件中编辑好宏，用的时候调用，
;;; 现在可以利用DYN功能和WScript.Shell对象的SendKeys方法随机实现。
;;; 适用 AutoCAD 2006 及以上版本
;;; -------------------------------------------------------------
;;; 参数：
;;; MSG------字符串，提示信息；
;;; OPTS-----包含若干字符串的表，菜单选项；
;;; DFT------缺省值。
;|
示例：
(RightClickMenu "\n指定灯具类型" '("筒灯" "射灯" "吸顶灯" "吊顶") 2)
(RightClickMenu "\n指定灯具类型" '("筒灯" "射灯" "吸顶灯" "吊顶") nil)
|;
(defun RightClickMenu (MSG OPTS DFT / WS DYN I KEY NSTR NLL)
(setq WS(vlax-get-or-create-object "WScript.Shell")
DYN (getvar 'DYNMODE)
MSG (strcat MSG " [" (car OPTS) "(1)")
I 1
KEY "1"
)
(foreach X (cdr OPTS)
(setq NSTR (itoa (setq I (1+ I)))
MSG(strcat MSG "/" X "(" NSTR ")")
KEY(strcat KEY " " NSTR)
)
)
(if DFT
(setq NLL DFT
DFT (strcat " <" (nth (1- DFT) OPTS) ">")
)
(setq DFT "")
)
(setq MSG (strcat MSG "]" DFT ": "))
(setvar 'DYNMODE 1)
(initget KEY)
(vlax-invoke-method WS 'SendKeys "{down}")
(setq KEY (vl-catch-all-apply 'getkword (list MSG)))
(setvar 'DYNMODE DYN)
(vlax-release-object WS)
(if (not (vl-catch-all-error-p KEY))
(if KEY
(atoi KEY)
NLL
)
)
)
(defun C:CHJ ()
(VL-LOAD-COM)
(setq dimObj (car (entsel "\n选择要修改精度的尺寸标注: ")))
(setq str_0 (cdr (assoc 0 (entget dimObj))))
(while (and (/= str_0 "LWPOLYLINE") (/= str_0 "DIMENSION"))
(setq dimObj
(car (entsel "\n所选对象不是尺寸标注,请重新选择编辑对象: ")
)
)
(setq str_0 (cdr (assoc 0 (entget dimObj))))
)
(setq dimObj (vlax-ename->vla-object dimObj))
(setq newTolerance (RightClickMenu "\n尺寸精度显示" '("0" "0.0" "0.00" "0.000") 2))
(setq newTolerance (1- newTolerance))
(COND
((= newTolerance 0) (setq newTolerance acDimPrecisionZero))
((= newTolerance 1) (setq newTolerance acDimPrecisionOne))
((= newTolerance 2) (setq newTolerance acDimPrecisionTwo))
((= newTolerance 3) (setq newTolerance acDimPrecisionThree))
(t (progn (princ "标注精度未改变") (VL-EXIT-WITH-VALUE 0)))
)
;; 确定公差精度的改变
(vla-put-PrimaryUnitsPrecision dimObj newTolerance)
(vla-put-SuppressTrailingZeros dimObj :vlax-false)
;; 读取并显示替代标注公差精度
;(setq newTolerance (vla-get-PrimaryUnitsPrecision dimObj))
(princ)
)
;;;请教版主caoyin,AutoCAD 2006 以下版本应该怎么搞呢？ AutoCAD 2006 以下版本应该怎么搞呢？
顶一个！强力支持！！
哪天我也能做出一个这样的啊 本帖最后由 自贡黄明儒 于 2011-12-21 09:05 编辑
;;;不能正确运行，哪位好心人请帮改改，先谢了;;;第一次的选择只能作为第二次用，如何处理得到菜单现在运行的结果呢？
;;;********************************************************************************动态右键菜单
;;;DimensionShow选择要修改精度的尺寸标注
(defun C:DS (/ DIMOBJ NEWTOLERANCE)
;;子程序1
(defun UnLoadMenuGroup (iValue / rValue)
(if (menugroup iValue)
(progn
(if (not (vl-catch-all-error-p
(setq rValue
(vl-catch-all-apply
'vla-unload
(list
(vla-item (vla-get-menugroups (vlax-get-acad-object))
iValue
)
)
)
)
)
)
(setq rValue T)
)
rValue
)
)
)
;;end子程序1
;;子程序2,by xshirmp
(DEFUN gps->popupmenu (MENULST / ACADOBJ CURRMENUGROUP FLAG FN MENUS NEWMENU NEWMENUITEM OPENMACRO THISDOC)
(SETVAR "cmdecho" 0)
(SETQ FLAG nil)
(SETQ FN (OPEN "VbaMenu.mns" "w"))
(CLOSE FN)
(SETQ ACADOBJ (vlax-get-acad-object))
(SETQ THISDOC (vla-get-ActiveDocument ACADOBJ))
(SETQ MENUS (vla-get-MenuGroups ACADOBJ))
(UnLoadMenuGroup "VbaMenu")
(vla-Load MENUS "VbaMenu.mns")
(SETQ CURRMENUGROUP (vla-Item MENUS "VbaMenu"))
(IF (<= (vla-get-Count (vla-get-Menus CURRMENUGROUP)) 0)
(PROGN
(SETQ NEWMENU (vla-Add (vla-get-Menus CURRMENUGROUP) "V&BA Menu"))
(FOREACH N MENULST
(IF (= (TYPE N) (QUOTE STR))
(COND
((/= N "")
(SETQ OPENMACRO (STRCAT (CHR 3) (CHR 3) "(setq xxx " N ")" (CHR 32))
NEWMENUITEM (vla-AddMenuItem NEWMENU (1+ (vla-get-Count NEWMENU)) N OPENMACRO)
)
(vla-put-HelpString NEWMENUITEM N)
)
((= N "")
(vla-AddSeparator NEWMENU (1+ (vla-get-Count NEWMENU)))
)
)
)
)
(vla-Save CURRMENUGROUP acMenuFileCompiled)
)
(PRINC "\nThe menu is already loaded")
)
(PRIN1)
(MENUCMD "p0=VbaMenu.POP2")
(MENUCMD "p0=*")
)
;;end子程序2
;;;(gps->popupmenu '("Line" "" "Circle" "Arc")),击Circle返回(setq xxx Circle)
;;;(gps->popupmenu '("尺寸精度" "" "0" "0.0" "0.00" "0.000"))
(VL-LOAD-COM)
(setq dimObj (car (entsel "\n选择要修改精度的尺寸标注: ")))
(setq dimObj (vlax-ename->vla-object dimObj))
(gps->popupmenu '("尺寸精度" "" "0" "0.0" "0.00" "0.000"))
(setq xxx (VL-PRINC-TO-STRING xxx))
(COND
((= xxx "0") (setq newTolerance acDimPrecisionZero))
((= xxx "0.0") (setq newTolerance acDimPrecisionOne))
((= xxx "0.00") (setq newTolerance acDimPrecisionTwo))
((= xxx "0.000") (setq newTolerance acDimPrecisionThree))
(t (progn (princ "标注精度未改变") (VL-EXIT-WITH-VALUE 0)))
)
;; 确定公差精度的改变
(vla-put-PrimaryUnitsPrecision dimObj newTolerance)
(vla-put-SuppressTrailingZeros dimObj :vlax-false)
(princ)
)
;;;********************************************************************************动态右键菜单
本帖最后由 自贡黄明儒 于 2011-12-21 09:10 编辑
问题与7楼同
;;;********************************************************************************动态右键菜单
;;;DimensionShow选择要修改精度的尺寸标注
(defun DimensionShow1 ( / DIMOBJ NEWTOLERANCE)
(VL-LOAD-COM)
(setq dimObj (car (entsel "\n选择要修改精度的尺寸标注: ")))
(setq dimObj (vlax-ename->vla-object dimObj))
(MENUCMD "p0=CXinZhi.POP579")
(MENUCMD "p0=*")
(COND
((= xxx 0) (setq newTolerance acDimPrecisionZero))
((= xxx 1) (setq newTolerance acDimPrecisionOne))
((= xxx 2) (setq newTolerance acDimPrecisionTwo))
((= xxx 3) (setq newTolerance acDimPrecisionThree))
(t (progn (princ "标注精度未改变") (VL-EXIT-WITH-VALUE 0)))
)
;; 确定公差精度的改变
(vla-put-PrimaryUnitsPrecision dimObj newTolerance)
(vla-put-SuppressTrailingZeros dimObj :vlax-false)
(princ)
)
;;;********************************************************************************动态右键菜单
;|这段代码放入my菜单文件
***POP579
**OBJECTS_DIMENSION
[标注精度]
ID_DimensionShow0 ^C^C(setq xxx 0)
ID_DimensionShow1 ^C^C(setq xxx 1)
ID_DimensionShow2 ^C^C(setq xxx 2)
ID_DimensionShow3 ^C^C(setq xxx 3)
|; 一个变量都能搞定，
以前刚学LISP的时候弄的，因为本人是从系统变量开始入手的........;修改和设置标注精度作者：KAIXIN
(defun c:KJ_BJD ()
(setvar "cmdecho" 0)
(PRINC "\n修改和设置当前标注精度")
(setq dimdec (getvar "DIMDEC") )
(prompt "\n-->当前标注精度为:(" )(princ dimdec)(princ ")" )
(setq dimdec (getint "\n-->请输入新值: "))
(COMMAND "DIMDEC" dimdec)
(while (setq ss (ssget":s"'((0 . "DIMENSION"))))
(command "DIM1" "UP" ss "")
)
(PRINC "\n所选地方-->修改和设置标注精度完成！")(PRINC))
右键菜单---没玩过，个人感觉太慢！
页:
[1]
2