(XD::Block:setUnitScale)重设块比例，保证X,Y有一个为1.0，同时，图块外观不变

newer

1. ;|
   
2. 重设块比例，保证X,Y有一个为1.0，同时，图块外观不变
   
3. 参数：
   
4.   e -- INSERT块实体名
   
5. 
   
6. 返回值：
   
7.   T
   
8. |;
   
9. (defun XD::Block:setUnitScale (e / blkent blkname ents mat0 mat1 ori position scl scl-1 x)
   
10.   (if (= (xdrx_getpropertyvalue e "IsA") "AcDbBlockReference")
    
11.     (progn
    
12.       (setq scl-1 (xdrx_getpropertyvalue e "scalefactors")
    
13.             scl (apply
    
14.                   'min
    
15.                   (list (car scl-1) (cadr scl-1))
    
16.                 )
    
17.             position (xdrx_getpropertyvalue e "Position")
    
18.             blkent (xdrx_getPropertyValue e "BlockTableRecord")
    
19.             blkname (car blkent)
    
20.             blkent (cadr blkent)
    
21.             ori (xdrx_getPropertyValue blkent "Origin")
    
22.             mat0 (xdrx_matrix_identity 3)
    
23.             mat1 (xdrx_matrix_setscale mat0 scl ori)
    
24.             ents (xdrx_getpropertyvalue blkent "Entities")
    
25.       )
    
26.       (xdrx_entity_transform ents mat1)
    
27.       (xdrx_block_update e)
    
28.       (setq ents (xdrx_getpropertyvalue blkent "BlockReferenceEntities"))
    
29.       (mapcar
    
30.         '(lambda (x)
    
31.            (setq scl-1 (xdrx_getpropertyvalue x "scalefactors")
    
32.                  scl-1 (mapcar
    
33.                          '(lambda (x)
    
34.                             (* x (/ 1 scl))
    
35.                           )
    
36.                          scl-1
    
37.                        )
    
38.            )
    
39.            (xdrx_setpropertyvalue x "scalefactors" scl-1)
    
40.          )
    
41.         ents
    
42.       )
    
43.     )
    
44.   )
    
45.   t
    
46. )
    
47. 
    

;|<br /> 重设块比例，保证X,Y有一个为1.0，同时，图块外观不变<br /> 参数：<br />   e -- INSERT块实体名<br /> <br /> 返回值：<br />   T<br /> |;<br /> (defun XD::Block:setUnitScale (e / blkent blkname ents mat0 mat1 ori position scl scl-1 x)<br />   (if (= (xdrx_getpropertyvalue e "IsA") "AcDbBlockReference")<br />     (progn<br />       (setq scl-1 (xdrx_getpropertyvalue e "scalefactors")<br />             scl (apply<br />                   'min<br />                   (list (car scl-1) (cadr scl-1))<br />                 )<br />             position (xdrx_getpropertyvalue e "Position")<br />             blkent (xdrx_getPropertyValue e "BlockTableRecord")<br />             blkname (car blkent)<br />             blkent (cadr blkent)<br />             ori (xdrx_getPropertyValue blkent "Origin")<br />             mat0 (xdrx_matrix_identity 3)<br />             mat1 (xdrx_matrix_setscale mat0 scl ori)<br />             ents (xdrx_getpropertyvalue blkent "Entities")<br />       )<br />       (xdrx_entity_transform ents mat1)<br />       (xdrx_block_update e)<br />       (setq ents (xdrx_getpropertyvalue blkent "BlockReferenceEntities"))<br />       (mapcar<br />         '(lambda (x)<br />            (setq scl-1 (xdrx_getpropertyvalue x "scalefactors")<br />                  scl-1 (mapcar<br />                          '(lambda (x)<br />                             (* x (/ 1 scl))<br />                           )<br />                          scl-1<br />                        )<br />            )<br />            (xdrx_setpropertyvalue x "scalefactors" scl-1)<br />          )<br />         ents<br />       )<br />     )<br />   )<br />   t<br /> )<br /> <br />