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

woxin168 · 发表于 2023-12-16 12:14

直接改好，用这个：

;;; 修改标注线性比例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)
)

zilong136 · 发表于 2023-12-26 02:04

woxin168 发表于 2023-12-11 20:22
这个都能设置，当然可以，加几句话即可。不过需求不大，一幅图，要么1：1，要么不是，最大的问题是本来不是 ...

如果用此命令之前，原先的尺寸人为改动了的话，这个命令就不起作用了。

头大无恼 · 发表于 2024-1-28 13:19

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

把lisp文件保存的编码改为ANSI

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

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

评分