修改标注精度

lucas3 · 发表于 2014-8-12 12:09:27

求两个小lisp程序，修改标注精度与标注还原
修改标注精度：不修改标注样式，即时修改，运行命令后提示
->请输入标注的新精度(最大为8位) <2>:　
输入精度位数后，可框选标注

标注还原：
运行命令后：请选择对象:
框选标注　无论是内容替换，添加过前后缀，还是用上面程序修改过标注精度，都还原

Free-Lancer · 发表于 2014-8-12 12:09:28

lucas3 发表于 2014-8-13 00:31
大师，您好！感谢你的回复，能不能改精度与标注恢复使用两个不同的命令？因为标注恢复并不是针对恢复改过 ...

(defun c:t1 (/ n)
(fy:begin)
(if (and (ssget '((0 . "DIM*")))
(setq n (getint "\n精度: "))
(<= 0 n 8)
)
(vlax-for dim (fy:cset)
(vla-put-PrimaryUnitsPrecision dim n)
)
)
(fy:end)
(princ)
)
(defun c:t2 ()
(fy:begin)
(if (ssget '((0 . "DIM*")))
(vlax-for dim (fy:cset)
(vla-put-TextOverride dim "");_恢复默认文字
(vla-put-PrimaryUnitsPrecision
dim
(cdr
(assoc 271 (tblsearch "dimstyle" (vla-get-stylename dim)))
)
) ;_恢复默认样式标注精度
)
)
(fy:end)
(princ)
)

newer · 发表于 2014-8-12 12:48:43

本帖最后由 newer 于 2014-8-12 12:50 编辑

两种功能合并到一起了，回车恢复默认。

(defun c:XDTB_DimTol ()
(princ "\n请选取要改变标注精度的尺寸标注 <退出>: ")
(if (setq ss (ssget' ((0 . "DIMENSION"))))
(progn
(initget 4)
(setq n (getint "\n请输入保留小数位数<恢复默认>: "))
(setq n (cond
((not n)
-1
)
((> n 8)
8
)
(n)
)
)
(xdrx_begin)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq cna (last (xdrx_getpropertyvalue e "CLASSNAME")))
(cond
((or
(= "AcDbAlignedDimension" cna)
(= "AcDbRotatedDimension" cna)
)
(if (= -1 n)
(xdrx_dimension_removeoverride e 271)
(xdrx_dimension_setOverride e 271 n)
)
)
((or
(= "AcDb3PointAngularDimension" cna)
(= "AcDb2LineAngularDimension" cna)
)
(if (= -1 n)
(xdrx_dimension_removeOverride e 179)
(xdrx_dimension_setOverride e 179 n)
)
)
)
)
(xdrx_end)
)
)
(princ)
)

(defun c:XDTB_DimTol () 
  (princ "\n请选取要改变标注精度的尺寸标注 <退出>: ") 
  (if (setq ss (ssget' ((0 . "DIMENSION")))) 
    (progn 
      (initget 4) 
      (setq n (getint "\n请输入保留小数位数<恢复默认>: ")) 
      (setq n (cond 
                ((not n) 
                  -1 
                ) 
                ((> n 8) 
                  8 
                ) 
                (n) 
              ) 
      ) 
      (xdrx_begin) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (setq cna (last (xdrx_getpropertyvalue e "CLASSNAME"))) 
        (cond 
          ((or 
             (= "AcDbAlignedDimension" cna) 
             (= "AcDbRotatedDimension" cna) 
           ) 
            (if (= -1 n) 
              (xdrx_dimension_removeoverride e 271) 
              (xdrx_dimension_setOverride e 271 n) 
            ) 
          ) 
          ((or 
             (= "AcDb3PointAngularDimension" cna) 
             (= "AcDb2LineAngularDimension" cna) 
           ) 
            (if (= -1 n) 
              (xdrx_dimension_removeOverride e 179) 
              (xdrx_dimension_setOverride e 179 n) 
            ) 
          ) 
        ) 
      ) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
)

lucas3 · 发表于 2014-8-12 13:00:34

newer 发表于 2014-8-12 12:48
两种功能合并到一起了，回车恢复默认。

谢版主，恢复默认不好使，加了后缀后恢复不了，文字替代还存在，比如加%%D 文字替代下还是:<>%%d

另外不喜欢API，因为时间限制，经常还没怎么使用，就提示过期要更新，

newer · 发表于 2014-8-12 14:40:53

lucas3 发表于 2014-8-12 13:00
谢版主，恢复默认不好使，加了后缀后恢复不了，文字替代还存在，比如加%%D 文字替代下还是:%%d

另外不 ...

把你修改完的尺寸的图贴上来看看，我这里没问题。

另外，API现在好像是半年过期吧，够用了，API更新快，你可以随时来网站下载更新的版本。

newer · 发表于 2014-8-12 16:17:22

lucas3 发表于 2014-8-12 13:00
谢版主，恢复默认不好使，加了后缀后恢复不了，文字替代还存在，比如加%%D 文字替代下还是:%%d

另外不 ...

这个程序是修改按实际长度标注的尺寸。

修改过尺寸文字的尺寸就没改精度的必要了，因为实际数值已经没了，被你用固定的文字替代了，你这个文字没精度。

newer · 发表于 2014-8-12 16:19:29

lucas3 发表于 2014-8-12 13:00
谢版主，恢复默认不好使，加了后缀后恢复不了，文字替代还存在，比如加%%D 文字替代下还是:%%d

另外不 ...

你要恢复文字替代的，要修改下代码，这个文字替代的没修改精度的必要。

newer · 发表于 2014-8-12 16:21:34

本帖最后由 newer 于 2014-8-12 16:23 编辑

lucas3 发表于 2014-8-12 13:00
谢版主，恢复默认不好使，加了后缀后恢复不了，文字替代还存在，比如加%%D 文字替代下还是:%%d

另外不 ...

帮你贴个全的吧，下面的程序可以修改
[比例-0/字高-1/标值-2/精度-3/翻转-4/归位-5/颜色-6]

(defun $XDLSP_SSGET (ts filter)
(prompt (strcat "\n" ts))
(apply
'ssget
filter
)
)

(defun c:XDTB_DIMMod (/ ang cna e h n scl ss tf)
(if (not $XDTB_DIM_VAR)
(setq $XDTB_DIM_VAR "0")
)
(initget "0 1 2 3 4 5 6")
(if (not (setq tf (getkword (strcat "\n[比例-0/字高-1/标值-2/精度-3/翻转-4/归位-5/颜色-6]<"
$XDTB_DIM_VAR ">:"
)
)
)
)
(setq tf $XDTB_DIM_VAR)
(setq $XDTB_DIM_VAR tf)
)
(cond
((= tf "0")
(if (not (setq ss ($XDLSP_SSGET "选取要修改的尺寸标注<全选>:"
(list '((0 . "dim*")))
)
)
)
(setq ss (ssget "x" '((0 . "dim*"))))
)
(setq scl (getreal "\n新比例<恢复默认>:"))
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(if scl
(xdrx_dimension_setoverride e 40 scl)
(xdrx_dimension_removeOverride e 40)
)
)
)
((= tf "1")
(if (not (setq ss ($XDLSP_SSGET "选取要修改的尺寸标注<全选>:"
(list '((0 . "dim*")))
)
)
)
(setq ss (ssget "x" '((0 . "dim*"))))
)
(setq h (getreal "\n新字高<恢复默认>:"))
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(if h
(xdrx_dimension_setOverride e 140 h)
(xdrx_dimension_removeOverride e 140)
)
)
)
((= tf "3")
(princ "\n请选取要改变标注精度的尺寸标注 <退出>: ")
(if (setq ss (ssget' ((0 . "DIMENSION"))))
(progn
(initget 4)
(setq n (getint "\n请输入保留小数位数<恢复默认>: "))
(setq n (cond
((not n)
-1
)
((> n 8)
8
)
(n)
)
)
(xdrx_begin)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(setq cna (last (xdrx_object_className e)))
(cond
((or
(= "AcDbAlignedDimension" cna)
(= "AcDbRotatedDimension" cna)
)
(if (= -1 n)
(xdrx_dimension_removeoverride e 271)
(xdrx_dimension_setOverride e 271 n)
)
)
((or
(= "AcDb3PointAngularDimension" cna)
(= "AcDb2LineAngularDimension" cna)
)
(if (= -1 n)
(xdrx_dimension_removeOverride e 179)
(xdrx_dimension_setOverride e 179 n)
)
)
)
)
)
)
)
((= tf "4")
(c:xdtb_dimtxtrev)
)
((= tf "5")
(prompt "\n请选取要文字归位的尺寸实体<退出>:")
(if (setq ss (ssget '((0 . "dimension"))))
(progn
(xdrx_begin)
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(xdrx_dimension_useDefaultTextPosition e)
)
(xdrx_end)
)
)
)
((= tf "6")
(xdrx_begin)
(if (not $XDTB_DimTxtColor_val)
(setq $XDTB_DimTxtColor_val 7)
)
(initget 4)
(if (setq clr (getint (strcat "\n请输入标注文字的新颜色号(1-256)[1红/2黄/3绿/4青/5蓝/6紫/7白/0默认]<"
(itoa $XDTB_DimTxtColor_val) ">:"
)
)
)
(setq $XDTB_DimTxtColor_val clr)
)
(if (setq ss (ssget "x" '((0 . "dimension"))))
(progn
(xdrx_setsstodb ss 0)
(while (setq e (xdrx_getentdata 0))
(if (= 0 clr)
(xdrx_dimension_RemoveOverride e 178)
(xdrx_dimension_setOverride e 178 clr)
)
)
)
)
(xdrx_end)
)
)
(princ)
)

(defun c:XDTB_DIMMod (/ ang cna e h n scl ss tf) 
  (if (not $XDTB_DIM_VAR) 
    (setq $XDTB_DIM_VAR "0") 
  ) 
  (initget "0 1 2 3 4 5 6") 
  (if (not (setq tf (getkword (strcat "\n[比例-0/字高-1/标值-2/精度-3/翻转-4/归位-5/颜色-6]<" 
                                      $XDTB_DIM_VAR ">:" 
                              ) 
                    ) 
           ) 
      ) 
    (setq tf $XDTB_DIM_VAR) 
    (setq $XDTB_DIM_VAR tf) 
  ) 
  (cond 
    ((= tf "0") 
      (if (not (setq ss ($XDLSP_SSGET "选取要修改的尺寸标注<全选>:" 
                                      (list '((0 . "dim*"))) 
                        ) 
               ) 
          ) 
        (setq ss (ssget "x" '((0 . "dim*")))) 
      ) 
      (setq scl (getreal "\n新比例<恢复默认>:")) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (if scl 
          (xdrx_dimension_setoverride e 40 scl) 
          (xdrx_dimension_removeOverride e 40) 
        ) 
      ) 
    ) 
    ((= tf "1") 
      (if (not (setq ss ($XDLSP_SSGET "选取要修改的尺寸标注<全选>:" 
                                      (list '((0 . "dim*"))) 
                        ) 
               ) 
          ) 
        (setq ss (ssget "x" '((0 . "dim*")))) 
      ) 
      (setq h (getreal "\n新字高<恢复默认>:")) 
      (xdrx_setsstodb ss 0) 
      (while (setq e (xdrx_getentdata 0)) 
        (if h 
          (xdrx_dimension_setOverride e 140 h) 
          (xdrx_dimension_removeOverride e 140) 
        ) 
      ) 
    ) 
    ((= tf "3") 
      (princ "\n请选取要改变标注精度的尺寸标注 <退出>: ") 
      (if (setq ss (ssget' ((0 . "DIMENSION")))) 
        (progn 
          (initget 4) 
          (setq n (getint "\n请输入保留小数位数<恢复默认>: ")) 
          (setq n (cond 
                    ((not n) 
                      -1 
                    ) 
                    ((> n 8) 
                      8 
                    ) 
                    (n) 
                  ) 
          ) 
          (xdrx_begin) 
          (xdrx_setsstodb ss 0) 
          (while (setq e (xdrx_getentdata 0)) 
            (setq cna (last (xdrx_object_className e))) 
            (cond 
              ((or 
                 (= "AcDbAlignedDimension" cna) 
                 (= "AcDbRotatedDimension" cna) 
               ) 
                (if (= -1 n) 
                  (xdrx_dimension_removeoverride e 271) 
                  (xdrx_dimension_setOverride e 271 n) 
                ) 
              ) 
              ((or 
                 (= "AcDb3PointAngularDimension" cna) 
                 (= "AcDb2LineAngularDimension" cna) 
               ) 
                (if (= -1 n) 
                  (xdrx_dimension_removeOverride e 179) 
                  (xdrx_dimension_setOverride e 179 n) 
                ) 
              ) 
            ) 
          ) 
        ) 
      ) 
    ) 
    ((= tf "4") 
      (c:xdtb_dimtxtrev) 
    ) 
    ((= tf "5") 
      (prompt "\n请选取要文字归位的尺寸实体<退出>:") 
      (if (setq ss (ssget '((0 . "dimension")))) 
        (progn 
          (xdrx_begin) 
          (xdrx_setsstodb ss 0) 
          (while (setq e (xdrx_getentdata 0)) 
            (xdrx_dimension_useDefaultTextPosition e) 
          ) 
          (xdrx_end) 
        ) 
      ) 
    ) 
    ((= tf "6") 
      (xdrx_begin) 
      (if (not $XDTB_DimTxtColor_val) 
        (setq $XDTB_DimTxtColor_val 7) 
      ) 
      (initget 4) 
      (if (setq clr (getint (strcat "\n请输入标注文字的新颜色号(1-256)[1红/2黄/3绿/4青/5蓝/6紫/7白/0默认]<" 
                                    (itoa $XDTB_DimTxtColor_val) ">:" 
                            ) 
                    ) 
          ) 
        (setq $XDTB_DimTxtColor_val clr) 
      ) 
      (if (setq ss (ssget "x" '((0 . "dimension")))) 
        (progn 
          (xdrx_setsstodb ss 0) 
          (while (setq e (xdrx_getentdata 0)) 
            (if (= 0 clr) 
              (xdrx_dimension_RemoveOverride e 178) 
              (xdrx_dimension_setOverride e 178 clr) 
            ) 
          ) 
        ) 
      ) 
      (xdrx_end) 
    ) 
  ) 
  (princ) 
)

lucas3 · 发表于 2014-8-12 17:04:41

newer 发表于 2014-8-12 16:21
帮你贴个全的吧，下面的程序可以修改
[比例-0/字高-1/标值-2/精度-3/翻转-4/归位-5/颜色-6]

感谢版主费心，发布到“插件发布”版块吧，太强大也不是好事，偶也用不上啊，我只是需要那两个功能的纯lisp程序，脱离API的那种

csharp · 发表于 2014-8-12 18:36:22

lucas3 发表于 2014-8-12 17:04
感谢版主费心，发布到“插件发布”版块吧，太强大也不是好事，偶也用不上啊，我只是需要那两个功能的纯li ...

啥叫纯lisp？！

lucas3 · 发表于 2014-8-12 19:00:23

csharp 发表于 2014-8-12 18:36
啥叫纯lisp？！

说错了，就是不用加载API的，或者其它编译过的函数库的，大师你应该能明白，只是我表达不清

zxq0220 · 发表于 2014-8-12 21:18:14

(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq n (getint "\n请输入保留小数位数<恢复默认>: ")) (progn
(setvar "DIMDEC" (if (> n 8) 8 n))
(setvar "DIMZIN" 0)
)
(setvar "DIMZIN" 8)
)
(command "-DIMSTYLE" "S" (getvar "DIMSTYLE") "Y")
(if (and (princ "\n请选取要改变标注精度的尺寸标注 <退出>: ")
(setq ss (ssget' ((0 . "DIMENSION")))))
(command "-DIMSTYLE" "A" ss)
)
(princ)
)

lucas3 · 发表于 2014-8-12 22:59:42

zxq0220 发表于 2014-8-12 21:18

Ｚ版，不行哟，您这是改的标注样式哟，我不是想要改标注样式，只是改框选中的尺寸的精度，另外，标注还原也是还原框选中的标注，就是去除前后缀，去除文字替代

Free-Lancer · 发表于 2014-8-12 23:57:55

lucas3 发表于 2014-8-12 22:59
Ｚ版，不行哟，您这是改的标注样式哟，我不是想要改标注样式，只是改框选中的尺寸的精度，另外，标注还原 ...

作为使用者也好，自己写也好，只要不做职业作程序，能用就要满足

(defun c:tt (/ n)
(fy:begin)
(if (and (ssget '((0 . "DIM*")))
(progn
(setq n (getint "\n精度<回车默认>: "))
t
)
)
(if n
(vlax-for dim (fy:cset)
(vla-put-PrimaryUnitsPrecision dim n)
)
(vlax-for dim (fy:cset)
(vla-put-TextOverride dim "")
(vla-put-PrimaryUnitsPrecision dim (getvar "dimdec"))
)
)
)
(fy:end)
(princ)
)

lucas3 · 发表于 2014-8-13 00:31:19

Free-Lancer 发表于 2014-8-12 23:57
作为使用者也好，自己写也好，只要不做职业作程序，能用就要满足

大师，您好！感谢你的回复，能不能改精度与标注恢复使用两个不同的命令？因为标注恢复并不是针对恢复改过精度的，所以作为两个不同的命令比较好！有劳大师了

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

[求助] 修改标注精度

最佳答案

点评

点评

点评

点评

点评

点评

点评

点评

点评