树櫴希德 发表于 2016-6-16 10:12:58

多段线中心缩放

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun vxs (e / i v lst)
(setq i 0)
(while
    (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
   (setq lst (cons v lst))
)
(reverse lst))
;;;;;;;;;;;;;;;;;;;;;;;;
(defun zxd (ent / pts len pt )
(setq pts (vxs ent))
(setq len (length pts))
(setq pt (mapcar
'(lambda(x)
    (/ x len)
)
(apply
    'mapcar
    (cons '+ pts)
)
)
      )
pt
)



(defun c:zxscale ( / i lst sc)
(setq sc (getreal "\n请输入缩放系数1.00："))
(setq i 0)
(setq lst (ssget '( (0 . "*polyline") (8 . "0")) ) )


(repeat (sslength lst)
(setq ent (ssname lst i))

(command "_.scale" ent "" (zxd ent) sc)
(setq i (+ i 1))
)

)

spp_wall 发表于 2016-6-16 11:06:43

感觉和偏移差不多啊

yoyoho 发表于 2016-6-16 12:31:08

感谢 树櫴希德 楼主分享程序!

l282027798 发表于 2018-11-13 11:34:23

你好，请问中心点那个函数具体怎么实现的，可以见解一下吗？

skg123 发表于 2019-3-6 13:44:22

l282027798 发表于 2018-11-13 11:34
你好，请问中心点那个函数具体怎么实现的，可以见解一下吗？

;;;;;;;;;;;;;;;;;;;;;;;;
(defun zxd (ent / pts len pt )
(setq pts (vxs ent))
(setq len (length pts))
(setq pt (mapcar
'(lambda(x)
    (/ x len)
)
(apply
    'mapcar
    (cons '+ pts)
)
)
      )
pt
)

utopio 发表于 2021-11-24 19:11:56

貌似把图层固定在了0层后，将(8 . "0")组码删除既可。

白色微風1991 发表于 2021-11-26 07:43:38

感謝樹櫴希德樓主分享程序!

Anlimer 发表于 2022-5-19 07:22:37

回帖是一种美德！

无厘崖 发表于 2022-10-19 16:09:06

感谢分享！很实用
页: [1]
查看完整版本: 多段线中心缩放