设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › [求助]快速修改尺寸显示精度？
12下一页
返回列表 发新帖
查看: 4570|回复: 13

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

  [复制链接]
自贡黄明儒
发表于 2011-12-16 08:30:09 | 显示全部楼层 |阅读模式
本论坛上没有见到如何修改尺寸显示精度，请教各位有没有好方法？

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
"觉得好，就打赏"
打赏
还没有人打赏，支持一下

本帖被以下淘专辑推荐:

  • · excel|主题: 80, 订阅: 3
回复

使用道具 举报

燃烧
发表于 2011-12-16 12:23:40 | 显示全部楼层
我想了下，写了如下的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)
)

评分

参与人数 1明经币 +1 收起 理由
自贡黄明儒 + 1 很给力!

查看全部评分

回复 支持 1 反对 0

使用道具 举报

gzcsun
发表于 2024-10-8 14:47:59 | 显示全部楼层
其实一个命令就可以 aidimprec
回复 支持 反对

使用道具 举报

tempasdf
发表于 2024-10-6 16:36:11 | 显示全部楼层

谢谢分享 这样的好工具
回复 支持 反对

使用道具 举报

duotu007
发表于 2011-12-16 09:03:45 | 显示全部楼层
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=89353
回复 支持 反对

使用道具 举报

自贡黄明儒
 楼主| 发表于 2011-12-16 12:08:55 | 显示全部楼层
本帖最后由 自贡黄明儒 于 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 以下版本应该怎么搞呢？

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

点评

caoyin
06版以下要创建菜单，好像论坛有类似帖子  发表于 2011-12-19 16:25
回复 支持 反对

使用道具 举报

自贡黄明儒
 楼主| 发表于 2011-12-16 12:25:51 | 显示全部楼层
AutoCAD 2006 以下版本应该怎么搞呢？
回复 支持 反对

使用道具 举报

zyhandw
发表于 2011-12-16 13:52:11 | 显示全部楼层
顶一个！强力支持！！
哪天我也能做出一个这样的啊
回复 支持 反对

使用道具 举报

自贡黄明儒
 楼主| 发表于 2011-12-20 16:41:36 | 显示全部楼层
本帖最后由 自贡黄明儒 于 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)
)
;;;********************************************************************************动态右键菜单

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

自贡黄明儒
 楼主| 发表于 2011-12-21 09:06:34 | 显示全部楼层
本帖最后由 自贡黄明儒 于 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)
|;

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x

点评

【KAIXIN】
只会设置和改以后的，以前的不会跟着变  发表于 2011-12-21 15:53
回复 支持 反对

使用道具 举报

【KAIXIN】
发表于 2011-12-21 09:30:23 | 显示全部楼层
一个变量都能搞定，
以前刚学LISP的时候弄的，因为本人是从系统变量开始入手的........
  2. ;修改和设置标注精度  作者：KAIXIN
  3. (defun c:KJ_BJD ()
  4. (setvar "cmdecho" 0)
  5. (PRINC "\n修改和设置当前标注精度")
  6. (setq dimdec (getvar "DIMDEC") )
  7. (prompt "\n-->当前标注精度为:(" )(princ dimdec)(princ ")  " )
  8. (setq dimdec (getint "\n-->请输入新值: "))
  9. (COMMAND "DIMDEC" dimdec)
  10. (while (setq ss (ssget":s"'((0 . "DIMENSION"))))
  11. (command "DIM1" "UP" ss "")
  12. )

  14. (PRINC "\n所选地方-->修改和设置标注精度完成！")(PRINC))

点评

自贡黄明儒
注：此法标注型式一同更改  发表于 2011-12-21 15:01
自贡黄明儒
你的这个很好，但我希望弹出右键菜单  发表于 2011-12-21 12:27
回复 支持 反对

使用道具 举报

【KAIXIN】
发表于 2011-12-21 12:35:56 | 显示全部楼层
右键菜单---没玩过，个人感觉太慢！

点评

自贡黄明儒
虽然如此，但用起来感觉爽呀!  发表于 2011-12-21 15:02
回复 支持 反对

使用道具 举报

12下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2025-2-22 02:37 , Processed in 0.247270 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表