(XD::Block:ResetOrigin)修改图块插入点

newer

1. ;|
   
2. 修改图块插入点
   
3. 参数：
   
4.    e--- INSERT块实体名
   
5.    pnt--插入点（WCS）
   
6. 返回值：
   
7.    T
   
8. |;
   
9. (defun XD::Block:ResetOrigin (e pnt / blkent blkname blkrefs mat0 mat-blk-wcs matr mat-wcs-blk new-pnt new-pnt1 old-pnt x)
   
10.   (if (= (xdrx_getpropertyvalue e "IsA") "AcDbBlockReference")
    
11.     (progn
    
12.       (setq new-pnt pnt
    
13.             mat-blk-wcs (xdrx_getPropertyValue e "BlockTransform")
    
14.             old-pnt (xdrx_getpropertyvalue e "Position")
    
15.             blkent (xdrx_getPropertyValue e "BlockTableRecord")
    
16.             blkname (car blkent)
    
17.             blkent (cadr blkent)
    
18.             mat-wcs-blk (xdrx_matrix_inverse mat-blk-wcs)
    
19.             new-pnt1 (xdrx_point_transform new-pnt mat-wcs-blk)
    
20.             mat0 (xdrx_matrix_identity 3)
    
21.             blkrefs (xdrx_getPropertyValue blkent "BlockReferenceEntities")
    
22.             matR (xdrx_matrix_setTransLation mat0 (mapcar
    
23.                                                     '-
    
24.                                                     old-pnt
    
25.                                                     new-pnt
    
26.                                                   )
    
27.                  )
    
28.       )
    
29.       (xdrx_setPropertyValue blkent "Origin" new-pnt1)
    
30.       (xdrx_block_update blkname)
    
31.       (if (xdrx_getpropertyvalue blkent "HasAttributeDefinitions")
    
32.         (progn
    
33.           (xdrx_entity_transform (mapcar
    
34.                                    '(lambda (x)
    
35.                                       (xdrx_insert_getAttribs x)
    
36.                                     )
    
37.                                    blkrefs
    
38.                                  ) matR
    
39.           )
    
40.         )
    
41.       )
    
42.       (xdrx_entity_transform blkrefs (xdrx_matrix_inverse matR))
    
43.     )
    
44.   )
    
45. )
    
46. 
    

;|<br /> 修改图块插入点<br /> 参数：<br />    e--- INSERT块实体名<br />    pnt--插入点（WCS）<br /> 返回值：<br />    T<br /> |;<br /> (defun XD::Block:ResetOrigin (e pnt / blkent blkname blkrefs mat0 mat-blk-wcs matr mat-wcs-blk new-pnt new-pnt1 old-pnt x)<br />   (if (= (xdrx_getpropertyvalue e "IsA") "AcDbBlockReference")<br />     (progn<br />       (setq new-pnt pnt<br />             mat-blk-wcs (xdrx_getPropertyValue e "BlockTransform")<br />             old-pnt (xdrx_getpropertyvalue e "Position")<br />             blkent (xdrx_getPropertyValue e "BlockTableRecord")<br />             blkname (car blkent)<br />             blkent (cadr blkent)<br />             mat-wcs-blk (xdrx_matrix_inverse mat-blk-wcs)<br />             new-pnt1 (xdrx_point_transform new-pnt mat-wcs-blk)<br />             mat0 (xdrx_matrix_identity 3)<br />             blkrefs (xdrx_getPropertyValue blkent "BlockReferenceEntities")<br />             matR (xdrx_matrix_setTransLation mat0 (mapcar<br />                                                     '-<br />                                                     old-pnt<br />                                                     new-pnt<br />                                                   )<br />                  )<br />       )<br />       (xdrx_setPropertyValue blkent "Origin" new-pnt1)<br />       (xdrx_block_update blkname)<br />       (if (xdrx_getpropertyvalue blkent "HasAttributeDefinitions")<br />         (progn<br />           (xdrx_entity_transform (mapcar<br />                                    '(lambda (x)<br />                                       (xdrx_insert_getAttribs x)<br />                                     )<br />                                    blkrefs<br />                                  ) matR<br />           )<br />         )<br />       )<br />       (xdrx_entity_transform blkrefs (xdrx_matrix_inverse matR))<br />     )<br />   )<br /> )<br /> <br />

zteykmgscqh

{:soso_e142:}

cxjzxf

arx怎样写，能提供代码么，万分感谢！