关联实体缩放

st788796

每组是独立的线文字，非块或组
特殊情况用特殊方法，一个简单算法示意

1. ((defun c:tt (/ e  sp ep ss p pts bp up ss1)
   
2.   (if (setq e (car (entsel)))
   
3.     (progn
   
4.       (setq sp (vlax-curve-getstartpoint e)
   
5.             ep (vlax-curve-getendpoint e)
   
6.       )
   
7.       (or
   
8.         (and (setq ss (ssget "_C" sp sp '((0 . "lwpolyline") (70 . 1))))
   
9.              (setq p ep)
   
10.         )
    
11.         (and (setq ss (ssget "_C" ep ep '((0 . "lwpolyline") (70 . 1))))
    
12.              (setq p sp)
    
13.         )
    
14.       )
    
15.       (if p
    
16.         (progn
    
17.           (ssadd e ss)
    
18.           (setq        pts (mapcar 'cdr
    
19.                             (vl-remove-if
    
20.                               '(lambda (x) (/= (car x) 10))
    
21.                               (entget (ssname ss 0))
    
22.                             )
    
23.                     )
    
24.                 bp  (apply 'mapcar (cons 'min pts))
    
25.                 up  (apply 'mapcar (cons 'max pts))
    
26.                 ss1 (ssget "_W" bp up)
    
27.           )
    
28.           (if ss1
    
29.             (vl-cmdf ".scale" ss ss1 "" "_none" p 0.5)
    
30.             (vl-cmdf ".scale" ss "" "_None" p 0.5)
    
31.           )
    
32.         )
    
33.       )
    
34.     )
    
35.   )
    
36.   (princ)
    
37. )
    

((defun c:tt (/ e  sp ep ss p pts bp up ss1)<br />   (if (setq e (car (entsel)))<br />     (progn<br />       (setq sp (vlax-curve-getstartpoint e)<br />             ep (vlax-curve-getendpoint e)<br />       )<br />       (or<br />         (and (setq ss (ssget "_C" sp sp '((0 . "lwpolyline") (70 . 1))))<br />              (setq p ep)<br />         )<br />         (and (setq ss (ssget "_C" ep ep '((0 . "lwpolyline") (70 . 1))))<br />              (setq p sp)<br />         )<br />       )<br />       (if p<br />         (progn<br />           (ssadd e ss)<br />           (setq        pts (mapcar 'cdr<br />                             (vl-remove-if<br />                               '(lambda (x) (/= (car x) 10))<br />                               (entget (ssname ss 0))<br />                             )<br />                     )<br />                 bp  (apply 'mapcar (cons 'min pts))<br />                 up  (apply 'mapcar (cons 'max pts))<br />                 ss1 (ssget "_W" bp up)<br />           )<br />           (if ss1<br />             (vl-cmdf ".scale" ss ss1 "" "_none" p 0.5)<br />             (vl-cmdf ".scale" ss "" "_None" p 0.5)<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (princ)<br /> )<br />

/db_自贡黄明儒_

good job!{:soso_e124:}

434939575

/db_自贡黄明儒_ 发表于 2014-3-12 08:22
good job!

st788796老大的教学让我领教了mapcar 的功力。对他还有点消化不良。谢谢！

lianghui2018

支持一下:D

friendship12c

感谢楼主分享...支持一下

清风明月10

谢谢楼主代码分享！