社区 › AutoLISP/Visual LISP 编程技术 › 请教大家一个带标注的图元缩放问题，恳请出手相助！

wangxf888 发表于 2020-4-22 14:20:08

请教大家一个带标注的图元缩放问题，恳请出手相助！

问题同截图里面的描述，恳请大家出手帮忙一下，谢谢!!论坛里搜到以前G版写的一个代码，只能实现缩放后数值保持不变，但标注全局比例不能调整，这是G大以前写的代码：

这个G版已解决
图形大小缩放，标注尺寸值不变，用于局部视图
(defun c:cs (/ ss pt ss2 flag alst)
(defun lt:ss->list (ss / en)
    (vl-remove nil (mapcar '(lambda (x)
                           (if (= (type (setq en (cadr x))) 'ename) en)
                            )
                           (ssnamex ss)
                   )
    )
)
(if (and (setq ss (ssget))
         (setq pt (getpoint "\n指定缩放的基点: "))
      )
    (progn
      (if (setq ss2 (ssget "_p" '((0 . "DIMENSION"))))
      (progn
          (setq alst (mapcar '(lambda (d)
                               (setq d (vlax-ename->vla-object d))
                               (list d (vla-get-Measurement d))
                              )
                           (lt:ss->list ss2)
                     )
                flag T
          )
      )
      )
      (princ "\n指定缩放的比例因子: ")
      (command "_.scale" ss "" pt "\\")
      (if flag
      (mapcar '(lambda (x / d)
                  (setq d (car x))
                  (vla-put-LinearScaleFactor d (* (/ (cadr x) (vla-get-Measurement d))
                                                (vla-get-LinearScaleFactor d)
                                             )
                  )
               )
                alst
      )
      )
    )
)
(princ)
)

start4444 发表于 2020-4-22 14:20:09

wangxf888 发表于 2020-4-23 21:20
请start4444老师出手帮忙再调整下代码   谢谢！

(defun c:tt5 (/ alst flag lt:ss->list pt scf ss ss2)
(defun lt:ss->list (ss / en) (vl-remove nil (mapcar '(lambda (x) (if (= (type (setq en (cadr x))) 'ename) en)) (ssnamex ss))))
(if (and (setq ss (ssget)) (setq pt (getpoint "\n指定缩放的基点: ")))
    (progn
      (if (setq ss2 (ssget "_p" '((0 . "DIMENSION"))))
      (progn
          (setq alst (mapcar '(lambda (d) (setq d (vlax-ename->vla-object d)) (list d (vla-get-Measurement d))) (lt:ss->list ss2))
                                                  flag T
          )
      )
      )                                                     
      (command "_.scale" ss "" pt "\\")      
      (if flag
      (progn (mapcar '(lambda (x / d)(setq d (car x)) (vla-put-LinearScaleFactor d (* (/ (cadr x) (vla-get-Measurement d))(vla-get-LinearScaleFactor d)))) alst)
                                             (setq scf (getreal (strcat "\n设定标注全局比例<当前:" (rtos (vla-get-ScaleFactor (caar alst)) 2 1) ">:")))
                                             (mapcar '(lambda (x / d) (setq d (car x)) (vla-put-ScaleFactor d scf)) alst)
                                )
      )                       
    )
)
(princ)
)

mikewolf2k 发表于 2020-4-22 15:33:46

一般来说，全局比例是不变的，保持打印出来的文字是固定大小。
如果全局比例也跟着缩小，那么就相当于原来图形全部按比例缩小，通过设置打印比例，实质上是一样的，所以没有这么做的
如果你一定要这么做，那么批量选中这些标注，把全局比例统一改掉即可。

wangxf888 发表于 2020-4-23 00:22:44

首先感谢超版的耐心细致回复，只所以有这个要求是行业需要，不需要考虑打印输出的问题，我就单纯需要把甲方提供的图纸按一定比例缩放后进行加工，有原尺寸标注显示，缩放后再测量下实际尺寸，清晰明了，我们就可以加工了，不炸开标注直接缩放的话，图纸乱的一塌糊涂！

start4444 发表于 2020-4-23 00:58:49

调了一下，顺便学习一下高人的写码方式

(defun c:tt5 (/ ss pt ss2 flag alst)
(defun lt:ss->list (ss / en)
    (vl-remove nil (mapcar '(lambda (x)
                           (if (= (type (setq en (cadr x))) 'ename) en)
                            )
                           (ssnamex ss)
                   )
    )
)
(if (and (setq ss (ssget))
         (setq pt (getpoint "\n指定缩放的基点: "))
      )
    (progn
      (if (setq ss2 (ssget "_p" '((0 . "DIMENSION"))))
      (progn
          (setq alst (mapcar '(lambda (d)
                               (setq d (vlax-ename->vla-object d))
                               (list d (vla-get-Measurement d))
                              )
                           (lt:ss->list ss2)
                     )
                flag T
          )
      )
      )
      (princ "\n指定缩放的比例因子: ")
      (command "_.scale" ss "" pt "\\")
      (if flag
      (mapcar '(lambda (x / d)
                  (setq d (car x))
                  (vla-put-LinearScaleFactor d (* (/ (cadr x) (vla-get-Measurement d))
                                                (vla-get-LinearScaleFactor d)
                                             )
                  )
                                                                       (vla-put-ScaleFactor d (/ (/ (cadr x) (vla-get-Measurement d))
                                                (vla-get-LinearScaleFactor d)
                                             )
                  )
               )
                alst
      )
      )
    )
)
(princ)
)

wangxf888 发表于 2020-4-23 21:18:37

谢谢start4444老师的回复，我上次在论坛提问的一个问题也是您给解决的   现在您帮忙修改后的代码还差一步就完美了问题如截图缩描述：

wangxf888 发表于 2020-4-23 21:20:44

start4444 发表于 2020-4-23 00:58
调了一下，顺便学习一下高人的写码方式

(defun c:tt5 (/ ss pt ss2 flag alst)


请start4444老师出手帮忙再调整下代码   谢谢！

OooCcc 发表于 2020-4-23 22:22:50

功能贴，学习了！

wangxf888 发表于 2020-4-23 23:46:27

本帖最后由 wangxf888 于 2020-4-23 23:47 编辑

start4444 发表于 2020-4-23 22:46
(defun c:tt5 (/ alst flag lt:ss->list pt scf ss ss2)
(defun lt:ss->list (ss / en) (vl-remove ni ...
非常感谢start4444老师的及时回复，修改后的源码对我来说算比较完美了，很实用的一个工具，如果追求极致的话，就是想再完善两个地方1.全局标注比例不需要输入，直接当前*输入的缩放系数2.支持两种或两种以上的不同标注比例。可能要求有点高，见笑:P比较麻烦的话可无视这两点要求。再次感谢start4444老师再次感谢明经！

999999 发表于 2020-9-4 12:37:04

学习学习，谢谢各位大神的讨论

查看完整版本: 请教大家一个带标注的图元缩放问题，恳请出手相助！