请高手将下面俩程序合并，并考虑线型比例，谢谢！
本帖最后由 zag0666 于 2020-10-4 00:04 编辑缩放 作者caoyin--------这个图形缩放程序我用的效果是，尺寸值缩放了，其他没有考虑
带标注缩放 作者 陨落----这个图形缩放程序我用的效果是，尺寸值缩放没有考虑，线型比例没有考虑
请高手将这俩程序合并改进，考虑DIMLFAC DIMSCALE textsizeCELTSCALE 四个值的同步缩放更改，谢谢！
;作者 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))
))
)
对于dimension对象，还是直接用 Annotative特性吧。 e2002 发表于 2020-10-5 17:30
对于dimension对象，还是直接用 Annotative特性吧。
如版主能抽出时间的话，恳请版主将程序改好，
应该是涉及取值，并四则运算赋值，但本人不会写。
页:
[1]