请高手将下面俩程序合并，并考虑线型比例，谢谢！

zag0666

缩放 作者caoyin--------这个图形缩放程序我用的效果是，尺寸值缩放了，其他没有考虑
带标注缩放 作者 陨落----这个图形缩放程序我用的效果是，尺寸值缩放没有考虑，线型比例没有考虑

请高手将这俩程序合并改进，考虑DIMLFAC DIMSCALE textsize  CELTSCALE 四个值的同步缩放更改，谢谢！


;作者 caoyin
(defun c:test (/ 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)
)
-------------------------
;作者 陨落
(defun c:suof()
(vl-load-com)
(princ "选择需缩放的对象")
(setq ss (ssget))
(setq jd (vlax-3d-point (getpoint "输入基点")) bl (getreal "输入缩放的比例因子"))
      
(setq n 0)
(repeat (sslength ss)
(vla-scaleentity (vlax-ename->vla-object (ssname ss n)) jd bl)
(setq n (+ n 1))
)


  (setq ss1 (ssget "p" '((0 . "dimension"))))
  (setq i 0)
  (if ss1 (repeat (sslength ss1)
  (setq biaoz (vlax-ename->vla-object (ssname ss1 i)))
  (vla-put-TextHeight biaoz (* (vla-get-TextHeight biaoz) bl));缩放文字大小
  (vla-put-ArrowheadSize biaoz (* (vla-get-ArrowheadSize biaoz) bl));缩放箭头大小
(vla-put-TextGap biaoz (* (vla-get-TextGap biaoz) bl));缩放文字偏移
(vla-put-PrimaryUnitsPrecision biaoz acDimPrecisionZero);修改标注精度
  (vla-update biaoz)
    (setq i (+ i 1))
    ))

  )

e2002

对于dimension对象，还是直接用 Annotative特性吧。

zag0666

e2002 发表于 2020-10-5 17:30
对于dimension对象，还是直接用 Annotative特性吧。

如版主能抽出时间的话，恳请版主将程序改好，
应该是涉及取值，并四则运算赋值，但本人不会写。