检查图纸中尺寸标注的比例，并设置成需要的线性比例

woxin168

;;;检查图纸中尺寸标注的比例，并设置成需要的线性比例,用于解决尺寸标注比例系数不是1的情况下，偶然个别尺寸忘改的问题。


(defun c:zzzz (/ oldvalue nb ss newvalue sel obj i newvalue1 newvalue2 sz szz)
  (setvar "cmdecho" 0)
  (textpage)
  (if (= newvalue2 nil)  (setq newvalue2 "1")  )
  (princ "\n 请选择标注:")
  (setq        ss (ssget '((0 . "DIMENSION")))  nb 0  )
  (if (/= ss nil) (setq nb (sslength ss)))
  
  (setq i 0)
  (repeat nb
       (setq oldvalue (vla-get-linearscalefactor (vlax-ename->vla-object (ssname ss i)) )  )
       (setq sz (cons oldvalue sz))
       (princ (strcat "\n 第 "(rtos (1+ i)) " 个标注，线性比例是" (rtos oldvalue)))
       (setq i (1+ i))
    )
    (setq szz nil)
    (while (setq szz (cons (car sz) szz) sz (vl-remove(car sz)(cdr sz))))
    (setq sz (reverse szz))  ;消重

   (setq i  (length sz))
   (princ (strcat "\n 共有" (rtos i) "种线性比例是: " ))

   (setq  szz sz)
       (repeat  (length szz)
       (setq aa (car szz) szz (cdr szz))
       (princ (strcat " "(rtos aa) " " ))
       )
  (setq newvalue1 (getstring  (strcat "\n 请输入新尺寸比例<dimlfac>，输入回车表示取消 :") )  )

  (if (/= newvalue1 "")
    (progn
      (setq newvalue (atof newvalue1))
      (setq i 0)
      (repeat nb
        (progn
          (setq sel (ssname ss i))
          (setq obj (vlax-ename->vla-object sel))
          (vla-put-linearscalefactor obj newvalue)
          (setq i (1+ i))
        )))
  (princ "\n 用户取消尺寸线性比例设置 ")   
  )
  
  (setq newvalue2 newvalue1)
  (princ "\n 尺寸线性比例设置完毕，欢迎使用  2023-12-9 ")
  (princ)
)

woxin168

直接改好，用这个：

;;; 修改标注线性比例BZXX。
(defun c:BZXX (/ oldvalue nb ss newvalue sel obj i newvalue1 newvalue2 sz szz)
  (setvar "cmdecho" 0)
  (textpage)
  (sssetfirst nil)
  (if (= newvalue2 nil)  (setq newvalue2 "1")  )
  (princ "\n 请选择标注:")
  (setq        ss (ssget '((0 . "DIMENSION")))  nb 0  )

  (if (/= ss nil) (setq nb (sslength ss)))
  
  (setq i 0 ss1 (ssadd) )
  (repeat nb
       (setq oldvalue (vla-get-linearscalefactor (vlax-ename->vla-object (ssname ss i)) )  )
       (setq sz (cons oldvalue sz))
       (princ (strcat "\n 第 "(rtos (1+ i)) " 个标注，线性比例是" (rtos oldvalue)))
       (if (/= oldvalue 1.0)
           (setq ss1 (ssadd (ssname ss i) ss1)))
   
       (setq i (1+ i))
    )
  
   (if (< (sslength ss1) 100)   ;小于100个夹点亮显,大于则普通亮显,因为选择大于100不能夹点亮显
       (sssetfirst nil ss1)     ;比例不是1的,且数量小于100时亮显。
       (draw ss1 3))
   
  
    (setq szz nil)
    (while (setq szz (cons (car sz) szz) sz (vl-remove(car sz)(cdr sz))))
    (setq sz (reverse szz))  ;消重

  
   (setq i  (length sz))
   (princ (strcat "\n 共有" (rtos i) "种线性比例是: " ))

   (setq  szz sz)
   (repeat  (length szz)
       (setq aa (car szz) szz (cdr szz))
       (princ (strcat " "(rtos aa) " " )) )

  (setq        newvalue1 1.0)
  (setq        newvalue1 (getstring  (strcat "\n 请输入新尺寸比例<dimlfac>，输入回车表示取消 :") )  )

  (if (/= newvalue1 "")
    (progn
      (setq newvalue (atof newvalue1))
      (setq i 0)
      (repeat nb
        (progn
          (setq sel (ssname ss i))
          (setq obj (vlax-ename->vla-object sel))
          (vla-put-linearscalefactor obj newvalue)
          (setq i (1+ i))
        )))
     (princ "\n 用户取消尺寸线性比例设置 ")   
   )
  
  (defun draw (ss i / j)               ; 亮显子函数
    (repeat (setq j (sslength ss))
      (redraw (ssname ss (setq j (1- j))) i)
    )
  )
  
   (princ "\n 尺寸线性比例设置完毕，欢迎使用  2023-12-9 ")
  (princ)
)

woxin168

这个都能设置，当然可以，加几句话即可。不过需求不大，一幅图，要么1：1，要么不是，最大的问题是本来不是1：1的，但偶尔弄成1：1的，很难发现，所以用此命令，直接选择一张不是1：1的图，设置成多少，全图刷新，确保漏网之鱼。
   这个程序有个问题，就是遇到角度尺寸，就会出错，因为角度尺寸没有线性比例的属性。这个正在考虑如何解决中。现在人为就是剔除角度尺寸。

woxin168

一页图纸一把检查出结果，不用像以往那样，一个个尺寸查看标注比例。

zilong136

怎么是繁体字，表示不会用

woxin168

zilong136 发表于 2023-12-10 15:56
怎么是繁体字，表示不会用

?
没有啊，简体的啊。

cj52000

woxin168 发表于 2023-12-10 12:25
一页图纸一把检查出结果，不用像以往那样，一个个尺寸查看标注比例。

这个能把不是1:1的尺寸全高亮选中吗

woxin168

抽空加两句话，满足楼上的亮显需求：
      (setq  ss1 (ssadd) )
      (if (/= oldvalue 1.0)
           (setq ss1 (ssadd (ssname ss i) ss1)))
  (sssetfirst nil ss1)
即可满足不是1：1的亮显。

paulpipi

感谢分享，很好用

cj52000

woxin168 发表于 2023-12-13 19:29
抽空加两句话，满足楼上的亮显需求：
      (setq  ss1 (ssadd) )
      (if (/= oldvalue 1.0)

谢谢，具体是加在哪一块啊，我加在以下位置还是没有亮显

woxin168

加的位置不对。