[求助]快速修改尺寸显示精度？

自贡黄明儒 · 发表于 2011-12-16 08:30

本论坛上没有见到如何修改尺寸显示精度，请教各位有没有好方法？

燃烧 · 发表于 2011-12-16 12:23

我想了下，写了如下的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)
)

duotu007 · 发表于 2011-12-16 09:03

http://bbs.mjtd.com/forum.php?mod=viewthread&tid=89353

自贡黄明儒 · 发表于 2011-12-16 12:08

本帖最后由自贡黄明儒于 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 以下版本应该怎么搞呢？

自贡黄明儒 · 发表于 2011-12-16 12:25

AutoCAD 2006 以下版本应该怎么搞呢？

zyhandw · 发表于 2011-12-16 13:52

顶一个！强力支持！！
哪天我也能做出一个这样的啊

自贡黄明儒 · 发表于 2011-12-20 16:41

本帖最后由自贡黄明儒于 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:06

本帖最后由自贡黄明儒于 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    [0]^C^C(setq xxx 0)
ID_DimensionShow1    [0.0]^C^C(setq xxx 1)
ID_DimensionShow2    [0.00]^C^C(setq xxx 2)
ID_DimensionShow3    [0.000]^C^C(setq xxx 3)
|;

【KAIXIN】 · 发表于 2011-12-21 09:30

一个变量都能搞定，
以前刚学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))

【KAIXIN】 · 发表于 2011-12-21 12:35

右键菜单---没玩过，个人感觉太慢！

账号		自动登录	找回密码
密码			注册

[求助]快速修改尺寸显示精度？

本帖子中包含更多资源

本帖被以下淘专辑推荐:

评分

本帖子中包含更多资源

点评

本帖子中包含更多资源

本帖子中包含更多资源

点评

点评

点评