多段线中心缩放

树櫴希德

2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   
3. (defun vxs (e / i v lst)
   
4.   (setq i 0)
   
5.   (while
   
6.     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))
   
7.      (setq lst (cons v lst))
   
8.   )
   
9.   (reverse lst))
   
10. ;;;;;;;;;;;;;;;;;;;;;;;;
    
11. (defun zxd (ent / pts len pt )
    
12. (setq pts (vxs ent))
    
13.   (setq len (length pts))
    
14. (setq pt (mapcar
    
15.   '(lambda(x)
    
16.     (/ x len)
    
17.   )
    
18.   (apply
    
19.     'mapcar
    
20.     (cons '+ pts)
    
21.   )
    
22.   )
    
23.       )
    
24.   pt
    
25.   )
    
26. 
    
27. 
    
28. 
    
29. (defun c:zxscale ( / i lst sc)
    
30. (setq sc (getreal "\n请输入缩放系数1.00："))
    
31. (setq i 0)
    
32.   (setq lst (ssget '( (0 . "*polyline") (8 . "0")) ) )
    
33. 
    
34. 
    
35. (repeat (sslength lst)
    
36.   (setq ent (ssname lst i))
    
37. 
    
38. (command "_.scale" ent "" (zxd ent) sc)
    
39. (setq i (+ i 1))
    
40.   )
    
41. 
    
42. )
    

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun vxs (e / i v lst)<br />   (setq i 0)<br />   (while<br />     (setq v (vlax-curve-getpointatparam e (setq i (1+ i))))<br />      (setq lst (cons v lst))<br />   )<br />   (reverse lst))<br /> ;;;;;;;;;;;;;;;;;;;;;;;;<br /> (defun zxd (ent / pts len pt )<br /> (setq pts (vxs ent))<br />   (setq len (length pts))<br /> (setq pt (mapcar<br />   '(lambda(x)<br />     (/ x len)<br />   )<br />   (apply<br />     'mapcar<br />     (cons '+ pts)<br />   )<br />   )<br />       )<br />   pt<br />   )<br /> <br /> <br /> <br /> (defun c:zxscale ( / i lst sc)<br /> (setq sc (getreal "\n请输入缩放系数1.00："))<br /> (setq i 0)<br />   (setq lst (ssget '( (0 . "*polyline") (8 . "0")) ) )<br /> <br /> <br /> (repeat (sslength lst)<br />   (setq ent (ssname lst i))<br /> <br /> (command "_.scale" ent "" (zxd ent) sc)<br /> (setq i (+ i 1))<br />   )<br /> <br /> )<br />

spp_wall

感觉和偏移差不多啊

yoyoho

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

l282027798

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

skg123

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

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

白色微風1991

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

Anlimer

回帖是一种美德！

无厘崖

感谢分享！很实用