马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。
您需要 登录 才可以下载或查看,没有帐号?立即注册
x
 - (defun c:XDTB_ImageRectangClip (/ olderr myerr
- _CornerToBoundBlock e
- pts ln p1
- p2 oBoundary cBoundary
- bpl vec pvec
- oBoundBlock lst
- )
- (defun myerr (msg)
- (princ "\n*cancel*")
- (xdrx_pointmonitor)
- (if cBoundary
- (xdrx_setpropertyvalue e "ClipBoundary" cBoundary)
- )
- (setq *error* olderr)
- (princ)
- )
- (defun _CornerToBoundBlock (p1 p2 vx vy /)
- (list p1
- (inters p1 (mapcar '+ p1 vy) p2 (mapcar '+ p2 vx) nil)
- p2
- (inters p1 (mapcar '+ p1 vx) p2 (mapcar '+ p2 vy) nil)
- )
- )
- (defun callback (dynpt / box ptl cBox)
- (redraw)
- (setq box (xd::pnts:ucs2wcs (XD::DOC:GetView4Pnt))
- ptl (xdrx_curve_getinters pts (xd::pnts:close box) 1)
- )
- (apply 'xdrx_grdraw (cons 1 (cons 1 ptl)))
- (apply 'xdrx_grdraw (cons 1 (cons 1 oBoundary)))
- (setq cBox (_CornerToBoundBlock (car pts) dynpt vec pvec))
- (if
- (apply 'and
- (mapcar '(lambda (x)
- (> (apply 'xdrx_point_getRelationAtClosedCurve
- (cons x oBoundary)
- )
- 1
- )
- )
- cbox
- )
- )
- (xdrx_setpropertyvalue e "ClipBoundary" cBox)
- )
- )
- (if (and (setq e (car (xdrx_entsel "\n选择图像: " '((0 . "IMAGE")))))
- (if (xdrx_getpropertyvalue e "IsClipped")
- (xdrx_setpropertyvalue e "removeClipBoundary" t)
- t
- )
- (setq oBoundary (xdrx_image_boundary e))
- (setq cBoundary (xdrx_getpropertyvalue e "ClipBoundary"))
- (if (and (setq p1 (getpoint "\n基准点: "))
- (setq p2 (getpoint p1 "\n方向: "))
- )
- (setq pts (list (trans p1 1 0) (trans p2 1 0)))
- )
- )
- (progn
- (if (< (apply 'xdrx_point_getRelationAtClosedCurve
- (cons (car pts) oBoundary)
- )
- 2
- )
- (progn
- (setq lst (xdrx_curve_getinters pts oBoundary 1))
- (if (< (distance (car pts) (car lst))
- (distance (car pts) (cadr lst))
- )
- (setq pts (cons (car lst) (cdr pts)))
- (setq pts (cons (cadr lst) (cdr pst)))
- )
- )
- )
- (setq olderr *error*
- *error* myerr
- vec (mapcar '- p2 p1)
- pvec (xdrx_vector_perpvector vec)
- )
- (xdrx_pointmonitor "callback")
- (setq p (getpoint "\n对角点: "))
- (xdrx_pointmonitor)
- (redraw)
- (setq *error* olderr)
- )
- )
- (princ)
- )
|