马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有账号?立即注册
×
- ;|
- 重设块比例,保证X,Y有一个为1.0,同时,图块外观不变
- 参数:
- e -- INSERT块实体名
- 返回值:
- T
- |;
- (defun XD::Block:setUnitScale (e / blkent blkname ents mat0 mat1 ori position scl scl-1 x)
- (if (= (xdrx_getpropertyvalue e "IsA") "AcDbBlockReference")
- (progn
- (setq scl-1 (xdrx_getpropertyvalue e "scalefactors")
- scl (apply
- 'min
- (list (car scl-1) (cadr scl-1))
- )
- position (xdrx_getpropertyvalue e "Position")
- blkent (xdrx_getPropertyValue e "BlockTableRecord")
- blkname (car blkent)
- blkent (cadr blkent)
- ori (xdrx_getPropertyValue blkent "Origin")
- mat0 (xdrx_matrix_identity 3)
- mat1 (xdrx_matrix_setscale mat0 scl ori)
- ents (xdrx_getpropertyvalue blkent "Entities")
- )
- (xdrx_entity_transform ents mat1)
- (xdrx_block_update e)
- (setq ents (xdrx_getpropertyvalue blkent "BlockReferenceEntities"))
- (mapcar
- '(lambda (x)
- (setq scl-1 (xdrx_getpropertyvalue x "scalefactors")
- scl-1 (mapcar
- '(lambda (x)
- (* x (/ 1 scl))
- )
- scl-1
- )
- )
- (xdrx_setpropertyvalue x "scalefactors" scl-1)
- )
- ents
- )
- )
- )
- t
- )
|