API应用动态矩形裁剪图像

st788796 · 发表于 2014-11-23 00:07:58

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

本帖最后由 st788796 于 2014-11-23 00:09 编辑

矩形判断尚未完成，明天继续完善

(defun c:tt (/ e box pts ln p1 p2 obox)
(defun callback (dynpt / ptl v1 p11 p12 nb)
(redraw)
(setq box (xd::pnts:ucs2wcs (XD::DOC:GetView4Pnt))
ptl (xdrx_curve_getinters pts (xd::pnts:close box) 1)
p11 (inters (car bpl)
(mapcar '+ (car bpl) pvec)
dynpt
(mapcar '+ dynpt vec)
nil
)
p12 (xdrx_curve_getinters (list p11 dynpt) ibox)
nb (list (car bpl)
p11
dynpt
(inters dynpt
(mapcar '+ dynpt pvec)
(car bpl)
(cadr bpl)
nil
)
)
)
(apply 'xdrx_grdraw (cons 1 (cons 1 obox)))
(apply 'xdrx_grdraw (cons 1 (cons 1 ptl)))
(apply 'xdrx_grdraw (cons 1 (cons 0 nb)))
(xdrx_setpropertyvalue e "ClipBoundary" nb)
)
(if (and (setq e (car (xdrx_entsel "\nPick Image: " '((0 . "IMAGE")))))
(if (xdrx_getpropertyvalue e "IsClipped")
(xdrx_setpropertyvalue e "removeClipBoundary" t)
t
)
(setq obox (xdrx_image_boundary e))
(setq ibox (xdrx_getpropertyvalue e "ClipBoundary"))
(if (setq ln (car (xdrx_entsel
"\nPick BaseLine<Enter to draw>: "
'((0 . "line"))
)
)
)
(setq pts (xdrx_getpropertyvalue ln "startpoint" "endpoint"))
(if (and (setq p1 (getpoint "\nFirset Point: "))
(setq p2 (getpoint p1 "\nSecond Point: "))
)
(setq pts (list p1 p2))
)
)
(setq bpl (vl-sort (xdrx_curve_getinters pts ibox 1)
'(lambda (x1 x2)
(if (equal (cadr x1) (cadr x2) 1e-3)
(< (car x1) (car x2))
(< (cadr x1) (cadr x2))
)
)
)
)
)
(progn
(setq vec (mapcar '- (cadr bpl) (car bpl))
pvec (xdrx_vector_perpvector vec)
)
(xdrx_pointmonitor "callback")
(setq p (getpoint "\nOrther Corner: "))
(xdrx_pointmonitor)
)
)
(princ)
)

(defun c:tt (/ e box pts ln p1 p2 obox) 
  (defun callback (dynpt / ptl v1 p11 p12 nb) 
    (redraw) 
    (setq box (xd::pnts:ucs2wcs (XD::DOC:GetView4Pnt)) 
          ptl (xdrx_curve_getinters pts (xd::pnts:close box) 1) 
          p11 (inters (car bpl) 
                      (mapcar '+ (car bpl) pvec) 
                      dynpt 
                      (mapcar '+ dynpt vec) 
                      nil 
              ) 
          p12 (xdrx_curve_getinters (list p11 dynpt) ibox) 
          nb  (list (car bpl) 
                    p11 
                    dynpt 
                    (inters dynpt 
                            (mapcar '+ dynpt pvec) 
                            (car bpl) 
                            (cadr bpl) 
                            nil 
                    ) 
              ) 
    ) 
    (apply 'xdrx_grdraw (cons 1 (cons 1 obox))) 
    (apply 'xdrx_grdraw (cons 1 (cons 1 ptl))) 
    (apply 'xdrx_grdraw (cons 1 (cons 0 nb))) 
    (xdrx_setpropertyvalue e "ClipBoundary" nb) 
  ) 
  (if (and (setq e (car (xdrx_entsel "\nPick Image: " '((0 . "IMAGE"))))) 
           (if (xdrx_getpropertyvalue e "IsClipped") 
             (xdrx_setpropertyvalue e "removeClipBoundary" t) 
             t 
           ) 
           (setq obox (xdrx_image_boundary e)) 
           (setq ibox (xdrx_getpropertyvalue e "ClipBoundary")) 
           (if (setq ln        (car (xdrx_entsel 
                               "\nPick BaseLine<Enter to draw>: " 
                               '((0 . "line")) 
                             ) 
                        ) 
               ) 
             (setq pts (xdrx_getpropertyvalue ln "startpoint" "endpoint")) 
             (if (and (setq p1 (getpoint "\nFirset Point: ")) 
                      (setq p2 (getpoint p1 "\nSecond Point: ")) 
                 ) 
               (setq pts (list p1 p2)) 
             ) 
           ) 
           (setq bpl (vl-sort (xdrx_curve_getinters pts ibox 1) 
                              '(lambda (x1 x2) 
                                 (if (equal (cadr x1) (cadr x2) 1e-3) 
                                   (< (car x1) (car x2)) 
                                   (< (cadr x1) (cadr x2)) 
                                 ) 
                               ) 
                     ) 
           ) 
      ) 
    (progn 
      (setq vec         (mapcar '- (cadr bpl) (car bpl)) 
            pvec (xdrx_vector_perpvector vec) 
      ) 
      (xdrx_pointmonitor "callback") 
      (setq p (getpoint "\nOrther Corner: ")) 
      (xdrx_pointmonitor) 
    ) 
  ) 
  (princ) 
)

liuyj · 发表于 2014-11-23 08:57:38

不错，再整个手绘多义段剪裁的。

iLisp · 发表于 2014-11-23 09:11:02

本帖最后由 iLisp 于 2014-11-23 09:12 编辑

liuyj 发表于 2014-11-23 08:57
不错，再整个手绘多义段剪裁的。

任意的反而简单，矩形要有个最大矩形，不知道楼主怎么处理？
看演示选择后复原了，中断时如何处理？

st788796 · 发表于 2014-11-23 12:14:59

这样计算还是有点繁琐，改用 AcGe 库重写

XDSoft · 发表于 2014-11-23 14:16:44

liuyj 发表于 2014-11-23 08:57
不错，再整个手绘多义段剪裁的。

手绘多段线的，好像提供过了吧，你想任意的多边形？

XDSoft · 发表于 2014-11-23 14:20:57

liuyj 发表于 2014-11-23 08:57
不错，再整个手绘多义段剪裁的。

这个应用主要是角度对齐最大矩形范围裁剪图像的。

st788796 · 发表于 2014-11-23 18:33:51

调整了一下，按拾取的起点开始拉矩形，新 API 的 BoundBlock 构造有点问题

(defun c:tt (/ 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)
)

(defun c:tt (/                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) 
)

newer · 发表于 2014-11-23 18:40:41

st788796 发表于 2014-11-23 18:33
调整了一下，按拾取的起点开始拉矩形，新 API 的 BoundBlock 构造有点问题

boundblock3d怎么了？

账号		自动登录	找回密码
密码			立即注册

[教学] API应用动态矩形裁剪图像

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

[教学] API应用 动态矩形裁剪图像

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

点评

点评

[教学] API应用动态矩形裁剪图像