关于如何计算XClip剪裁边界顶点坐标的研究

eachy · 发表于 2013-5-24 00:21:02

对于开关也就是0 1 用一个程序即可，0的话变1，1的话变0来自: iPhone客户端

XDSoft · 发表于 2013-5-24 00:49:48

eachy 发表于 2013-5-24 00:21
对于开关也就是0 1 用一个程序即可，0的话变1，1的话变0

咋用手机了，上床了啊。

牢固 · 发表于 2013-5-24 10:59:37

本帖最后由牢固于 2013-5-24 12:34 编辑

搞清楚了XCLIP剪裁边界的内在机制，下面要重新修改剪裁块的边界就很容易了。我们来看，11楼的代码由剪裁块计算出顶点的坐标是这样一个过程:
1、通过SPATIAL_FILTER对象，得到剪裁边界的原始定义顶点坐标表PL和该坐标转换到图块定义的转换矩阵M
2、通过图块计算出图块的BlockDef->BlockRef的转换矩阵M1
3、PL经过M和M1两次矩阵转换，就得到了剪裁边界的WCS坐标
重构剪裁边界，就是上述过程的一个逆过程:

1、根据图块计算出图块的BlockRef->BlockDef矩阵，即图块的逆矩阵M0
2、将新边界的顶点WCS坐标PL根据Mo矩阵转换到图块的定义坐标系
3、通过SPATIAL_FILTER对象，得到剪裁边界的原始定义顶点转换到图块定义的转换矩阵M1，并计算出M2的逆矩阵
4、再将第二步转换后的PL经过M2矩阵转换，转换到剪裁边界的原始定义坐标系
5、用新的PL坐标表更新SPATIAL_FILTER对象的的10组码表，并根据PL顶点个数更新70组码
6、更新显示图块

登录/注册后可看大图

相关矩阵函数参见高飞鸟的帖子:Lisp论矩阵

;;修改XCLIP边界
(defun c:tt ()
(while
(and
(setq e (car(entsel "\n选择剪裁块:")))
(setq Poly (car(entsel "\n选择剪裁边界:")))
)
(gxl-EditXclipBoundary e poly)
)
(princ)
)
;;(gxl-EditXclipBoundary ENAME BOUNDARY) 重构XCLip的剪裁边界,参数 ENAME=剪裁块图元 BOUNDARY=点表或多段线图元
;;(gxl-EditXclipBoundary (car(entsel "\n选择剪裁块:")) (car(entsel "\n选择剪裁边界:")))
(defun gxl-EditXclipBoundary (ENAME BOUNDARY / ISXCLIP
PTLIST PLIST EL M0
DXF40 M1 M N
)
(defun IsXClip (ename / xdict)
(if
(setq xdict (cdr (assoc 360 (entget ename))))
(IsXClip xdict)
(if
(eq "SPATIAL_FILTER"
(cdr (assoc 0 (setq ename (entget ename))))
)
ename
)
)
)
(if (= 'ename (type Boundary))
(setq PList (gxl-get_poly_ptList3 Boundary 0.05))
(if (= 'list (type Boundary))
(setq pList Boundary)
)
)
(if (and (setq el (IsXCLIP ename))
PList
)
(progn
;;计算图块的逆转换矩阵 Ref-> Del
(setq m0 (apply 'MAT:DISPTOMATRIX (MAT:RevRefGeom ename)))
;;计算剪切边界顶点转换到图块定义的矩阵
(setq dxf40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) el) ) ;_ 矩阵数据表 (if (= 1 (cdr (assoc 72 el))) (setq dxf40 (cdr dxf40)))
(setq m1
(list
(mapcar 'cdr
(list (nth 0 dxf40)
(nth 1 dxf40)
(nth 2 dxf40)
(nth 3 dxf40)
)
)
(mapcar 'cdr
(list (nth 4 dxf40)
(nth 5 dxf40)
(nth 6 dxf40)
(nth 7 dxf40)
)
)
(mapcar 'cdr
(list (nth 8 dxf40)
(nth 9 dxf40)
(nth 10 dxf40)
(nth 11 dxf40)
)
)
'(0 0 0 1)
)
)
;;矩阵m1求逆，计算出图块定义坐标变换到剪切边界的定义坐标系
(setq m1 (Mat:Inverse m1))
;;计算坐标PList经过m0 m1 矩阵变换到剪切边界的定义坐标系的矩阵
(setq m (MAT:MXM m1 m0))
;;计算PList经过矩阵m变换后的坐标
(setq PList (mapcar '(lambda (x) (MAT:MXP m x)) Plist))
(setq n (length PList)) ;_ 剪切边界的顶点数
(setq el (subst (cons 70 n) (assoc 70 el) el))
(setq el
(append
(reverse (member (assoc 70 el) (reverse el)))
(mapcar '(lambda (x) (cons 10 x)) PList)
(member (assoc 210 el) el)
)
)
;;更新边界
(entmod el)
(entupd ename) ;_ 更新图块
)
)
)
;;;gxl-get_poly_ptList3 返回多义线顶点点列表,有圆弧则用一定角度分割圆弧，闭合多义线点表不含闭合点坐标
(defun gxl-get_poly_ptList3 (ENT FGX / OBJNAME VERTEXSNUM
N PT PLIST SECDEV BUGLE
BJ D1 D2 D K
D0 PARAM
)
(setq objname
(cond
((GXL-CATCHAPPLY vla-get-ObjectName (list ent)))
((GXL-CATCHAPPLY gxl-dxf (list ent 0)))
)
)
(setq vertexsNum
(fix (vlax-curve-getEndParam ent))
n 0
) ;_ 结束setq
(cond ((or
(= "AcDbCircle" objname)
(= "CIRCLE" objname)
)
(if (equal fgx 0 1e-6)
(setq fgx pi2)
)
(setq vertexsNum
(fix (/ 2pi fgx))
n 0
)
(repeat vertexsNum
(setq pt (vlax-curve-getPointAtParam ent (* n fgx)))
(setq plist (cons pt plist)
n (1+ n)
)
)
(reverse plist)
)
(t
(if (or
(= "AcDb2dPolyline" objName)
(= "POLYLINE" objName)
)
(progn
(repeat vertexsNum
(setq pt (vlax-curve-getPointAtParam ent n))
(setq plist (cons pt plist))
(setq pt (vlax-curve-getPointAtParam ent (+ 0.25 n)))
(setq plist (cons pt plist))
(setq pt (vlax-curve-getPointAtParam ent (+ 0.5 n)))
(setq plist (cons pt plist))
(setq pt (vlax-curve-getPointAtParam ent (+ 0.75 n)))
(setq plist (cons pt plist))
(setq n (1+ n))
)
(if (not (vlax-curve-isClosed ent))
(setq plist (cons (vlax-curve-getEndPoint ent) plist))
) ;_ 结束if
(reverse plist)
)
(if (equal fgx 0 1e-6)
(progn
(if (= 'ename (type ent)) (setq ent (vlax-ename->vla-object ent)))
(setq h (list(cdr (assoc 38 (setq ent (entget ent))))))
(mapcar '(lambda (a) (cdr (append a h))) (vl-remove-if-not '(lambda (x) (= 10 (car x))) ent))
)
(progn
(repeat vertexsNum
(if (setq secdev (vlax-curve-getSecondDeriv ent n))
(progn
(setq pt (vlax-curve-getPointAtParam ent n)
bugle (vla-GetBulge ent n)
) ;_ 结束setq
(setq plist (cons pt plist))
(if (/= bugle 0.0)
(progn
(setq bj (* (atan (abs bugle)) 4))
(setq d1 (vlax-curve-getdistAtParam ent n)
d2 (vlax-curve-getdistAtParam ent (1+ n))
d (- d2 d1)
k (fix (/ bj fgx))
d0 (/ 1.0 (1+ k))
param n
) ;_ 结束setq
(if (equal d0 1.0 0.001)
(setq plist (cons (vlax-curve-getPointAtParam
ent
(+ 0.5 param)
)
plist
)
)
(repeat k
(setq plist (cons (vlax-curve-getPointAtParam
ent
(setq param (+ param d0))
)
plist
)
)
)
)
) ;_ 结束progn
) ;_ 结束if
)
)
(setq n (1+ n))
) ;_ 结束repeat
(if (not (vlax-curve-isClosed ent))
(setq plist (cons (vlax-curve-getEndPoint ent) plist))
) ;_ 结束if
(reverse plist)
)
)
)
)
)
)
(defun gxl-CatchApply ( fun args / result )
(if
(not
(vl-catch-all-error-p
(setq result
(vl-catch-all-apply (if (= 'SYM (type fun)) fun (function fun)) args)
)
)
)
result
)
)
;;; Mat:Inverse 求逆矩阵
;(Mat:Inverse m)
;;--------------------=={ Inverse Matrix }==------------------;;
;; ;;
;; Implements the Gauss-Jordan Elimination algorithm to ;;
;; inverse a non-singular nxn matrix. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright ? 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Arguments: m - nxn Matrix ;;
;;------------------------------------------------------------;;
;; Returns: Matrix inverse, or nil if matrix is singular ;;
;;------------------------------------------------------------;;
;; http://www.theswamp.org/index.php?topic=22638.msg439381#msg439381
(defun Mat:Inverse ( m / _identity _eliminate p r x )
;;计算单位矩阵
(defun _identity ( n / i j l m ) (setq i 1)
(repeat n (setq j 0)
(repeat n
(setq l (cons (if (= i (setq j (1+ j))) 1. 0.) l))
)
(setq m (cons l m) l nil i (1+ i)) m
)
)
(defun _eliminate ( m p )
(mapcar
(function
(lambda ( x / d )
(setq d (car x)) (mapcar (function (lambda ( a b ) (- a (* d b)))) (cdr x) p)
)
)
m
)
)
(setq m (mapcar 'append m (_identity (length m))))
(while m
(setq p (apply 'max (mapcar 'abs (mapcar 'car m))))
(while (not (equal p (abs (caar m)) 1e-14))
(setq m (append (cdr m) (list (car m))))
)
(if (equal 0.0 (caar m) 1e-14)
(setq m nil)
(setq p (/ 1. (caar m))
p (mapcar (function (lambda ( x ) (* p x))) (cdar m))
m (_eliminate (cdr m) p)
r (cons p (_eliminate r p))
)
)
)
(reverse r)
)

;;修改XCLIP边界 
(defun c:tt () 
  (while 
    (and 
      (setq e (car(entsel "\n选择剪裁块:"))) 
      (setq Poly (car(entsel "\n选择剪裁边界:"))) 
      ) 
    (gxl-EditXclipBoundary e poly) 
    ) 
  (princ) 
  ) 
 
;;(gxl-EditXclipBoundary ENAME BOUNDARY) 重构XCLip的剪裁边界,参数 ENAME=剪裁块图元 BOUNDARY=点表或多段线图元 
;;(gxl-EditXclipBoundary (car(entsel "\n选择剪裁块:")) (car(entsel "\n选择剪裁边界:"))) 
(defun gxl-EditXclipBoundary (ENAME BOUNDARY        /       ISXCLIP 
                                    PTLIST  PLIST   EL      M0 
                                    DXF40   M1      M       N 
                                    ) 
  (defun IsXClip (ename / xdict) 
    (if 
      (setq xdict (cdr (assoc 360 (entget ename)))) 
       (IsXClip xdict) 
       (if 
         (eq "SPATIAL_FILTER" 
               (cdr (assoc 0 (setq ename (entget ename)))) 
               ) 
          ename 
          ) 
       ) 
    ) 
  (if (= 'ename (type Boundary)) 
    (setq PList (gxl-get_poly_ptList3 Boundary 0.05)) 
    (if (= 'list (type Boundary)) 
      (setq pList Boundary) 
      ) 
    ) 
  (if (and (setq el (IsXCLIP ename)) 
           PList 
           ) 
    (progn 
      ;;计算图块的逆转换矩阵 Ref-> Del 
      (setq m0 (apply 'MAT:DISPTOMATRIX (MAT:RevRefGeom ename))) 
      ;;计算剪切边界顶点转换到图块定义的矩阵 
      (setq dxf40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) el) ) ;_ 矩阵数据表     (if (= 1 (cdr (assoc 72 el))) (setq dxf40 (cdr dxf40))) 
      (setq m1 
             (list 
               (mapcar 'cdr 
                       (list (nth 0 dxf40) 
                             (nth 1 dxf40) 
                             (nth 2 dxf40) 
                             (nth 3 dxf40) 
                             ) 
                       ) 
               (mapcar 'cdr 
                       (list (nth 4 dxf40) 
                             (nth 5 dxf40) 
                             (nth 6 dxf40) 
                             (nth 7 dxf40) 
                             ) 
                       ) 
               (mapcar 'cdr 
                       (list (nth 8 dxf40) 
                             (nth 9 dxf40) 
                             (nth 10 dxf40) 
                             (nth 11 dxf40) 
                             ) 
                       ) 
               '(0 0 0 1) 
               ) 
            ) 
      ;;矩阵m1求逆，计算出图块定义坐标变换到剪切边界的定义坐标系 
      (setq m1 (Mat:Inverse m1)) 
      ;;计算坐标PList经过m0 m1 矩阵变换到剪切边界的定义坐标系的矩阵 
      (setq m (MAT:MXM m1 m0)) 
      ;;计算PList经过矩阵m变换后的坐标 
      (setq PList (mapcar '(lambda (x) (MAT:MXP m x)) Plist)) 
      (setq n (length PList)) ;_ 剪切边界的顶点数 
      (setq el (subst (cons 70 n) (assoc 70 el) el)) 
      (setq el 
             (append 
               (reverse (member (assoc 70 el) (reverse el))) 
               (mapcar '(lambda (x) (cons 10 x)) PList) 
               (member (assoc 210 el) el) 
               ) 
            ) 
      ;;更新边界 
      (entmod el) 
      (entupd ename) ;_ 更新图块 
      ) 
    ) 
  ) 
;;;gxl-get_poly_ptList3 返回多义线顶点点列表,有圆弧则用一定角度分割圆弧，闭合多义线点表不含闭合点坐标 
(defun gxl-get_poly_ptList3 (ENT FGX  /      OBJNAME       VERTEXSNUM 
         N  PT     PLIST  SECDEV BUGLE 
         BJ  D1     D2     D       K 
         D0  PARAM 
        ) 
  (setq objname 
   (cond 
     ((GXL-CATCHAPPLY vla-get-ObjectName (list ent))) 
     ((GXL-CATCHAPPLY gxl-dxf (list ent 0))) 
     ) 
  ) 
  (setq  vertexsNum 
   (fix (vlax-curve-getEndParam ent)) 
  n 0 
  ) ;_ 结束setq 
  (cond  ((or 
     (= "AcDbCircle" objname) 
     (= "CIRCLE" objname) 
     ) 
   (if (equal fgx 0 1e-6) 
     (setq fgx pi2) 
   ) 
   (setq vertexsNum 
    (fix (/ 2pi fgx)) 
         n 0 
   ) 
   (repeat vertexsNum 
     (setq pt (vlax-curve-getPointAtParam ent (* n fgx))) 
     (setq plist (cons pt plist) 
     n     (1+ n) 
     ) 
   ) 
   (reverse plist) 
 
  ) 
  (t 
   (if (or 
         (= "AcDb2dPolyline" objName) 
         (= "POLYLINE" objName) 
         ) 
     (progn 
       (repeat vertexsNum 
         (setq pt (vlax-curve-getPointAtParam ent n)) 
         (setq plist (cons pt plist)) 
         (setq pt (vlax-curve-getPointAtParam ent (+ 0.25 n))) 
         (setq plist (cons pt plist)) 
         (setq pt (vlax-curve-getPointAtParam ent (+ 0.5 n))) 
         (setq plist (cons pt plist)) 
         (setq pt (vlax-curve-getPointAtParam ent (+ 0.75 n))) 
         (setq plist (cons pt plist)) 
         (setq n (1+ n)) 
       ) 
       (if (not (vlax-curve-isClosed ent)) 
         (setq plist (cons (vlax-curve-getEndPoint ent) plist)) 
       ) ;_ 结束if 
       (reverse plist) 
 
     ) 
            
     (if (equal fgx 0 1e-6) 
             (progn 
               (if (= 'ename (type ent)) (setq ent (vlax-ename->vla-object ent))) 
               (setq h (list(cdr (assoc 38 (setq ent (entget ent)))))) 
       (mapcar '(lambda (a) (cdr (append a h))) (vl-remove-if-not '(lambda (x) (= 10 (car x))) ent)) 
               ) 
       (progn 
          
         (repeat vertexsNum 
     (if (setq secdev (vlax-curve-getSecondDeriv ent n)) 
       (progn 
     (setq pt    (vlax-curve-getPointAtParam ent n) 
           bugle (vla-GetBulge ent n) 
     ) ;_ 结束setq 
     (setq plist (cons pt plist)) 
     (if (/= bugle 0.0) 
       (progn 
         (setq bj (* (atan (abs bugle)) 4)) 
         (setq d1   (vlax-curve-getdistAtParam ent n) 
         d2   (vlax-curve-getdistAtParam ent (1+ n)) 
         d   (- d2 d1) 
         k   (fix (/ bj fgx)) 
         d0   (/ 1.0 (1+ k)) 
         param n 
         ) ;_ 结束setq 
         (if (equal d0 1.0 0.001) 
           (setq plist (cons (vlax-curve-getPointAtParam 
             ent 
             (+ 0.5 param) 
           ) 
           plist 
           ) 
           ) 
           (repeat k 
       (setq plist (cons (vlax-curve-getPointAtParam 
               ent 
               (setq param (+ param d0)) 
             ) 
             plist 
             ) 
       ) 
           ) 
         ) 
       ) ;_ 结束progn 
     ) ;_ 结束if 
     ) 
       ) 
     (setq n (1+ n)) 
         ) ;_ 结束repeat 
         (if (not (vlax-curve-isClosed ent)) 
     (setq plist (cons (vlax-curve-getEndPoint ent) plist)) 
         ) ;_ 结束if 
         (reverse plist) 
       ) 
     ) 
   ) 
  ) 
  ) 
) 
 
(defun gxl-CatchApply ( fun args / result ) 
  (if 
    (not 
      (vl-catch-all-error-p 
        (setq result 
          (vl-catch-all-apply (if (= 'SYM (type fun)) fun (function fun)) args) 
        ) 
      ) 
    ) 
    result 
  ) 
) 
 
;;; Mat:Inverse 求逆矩阵 
;(Mat:Inverse m) 
;;--------------------=={ Inverse Matrix }==------------------;; 
;;                                                            ;; 
;;  Implements the Gauss-Jordan Elimination algorithm to      ;; 
;;  inverse a non-singular nxn matrix.                        ;; 
;;------------------------------------------------------------;; 
;;  Author: Lee Mac, Copyright ? 2011 - <a href=\"http://www.lee-mac.com\" target=\"_blank\">www.lee-mac.com</a>       ;; 
;;------------------------------------------------------------;; 
;;  Arguments: m - nxn Matrix                                 ;; 
;;------------------------------------------------------------;; 
;;  Returns:  Matrix inverse, or nil if matrix is singular    ;; 
;;------------------------------------------------------------;; 
;; <a href=\"http://www.theswamp.org/index.php?topic=22638.msg439381#msg439381\" target=\"_blank\">http://www.theswamp.org/index.php?topic=22638.msg439381#msg439381</a> 
(defun Mat:Inverse ( m / _identity _eliminate p r x ) 
  ;;计算单位矩阵 
  (defun _identity ( n / i j l m ) (setq i 1) 
    (repeat n (setq j 0) 
      (repeat n 
        (setq l (cons (if (= i (setq j (1+ j))) 1. 0.) l)) 
      ) 
      (setq m (cons l m) l nil i (1+ i)) m 
    ) 
  ) 
 
  (defun _eliminate ( m p ) 
    (mapcar 
      (function 
        (lambda ( x / d ) 
          (setq d (car x)) (mapcar (function (lambda ( a b ) (- a (* d b)))) (cdr x) p) 
        ) 
      ) 
      m 
    ) 
  ) 
  (setq m (mapcar 'append m (_identity (length m)))) 
   
  (while m 
    (setq p (apply 'max (mapcar 'abs (mapcar 'car m)))) 
    (while (not (equal p (abs (caar m)) 1e-14)) 
      (setq m (append (cdr m) (list (car m)))) 
    ) 
    (if (equal 0.0 (caar m) 1e-14) 
      (setq m nil) 
      (setq p (/ 1. (caar m)) 
            p (mapcar (function (lambda ( x ) (* p x))) (cdar m)) 
            m (_eliminate (cdr m) p) 
            r (cons p (_eliminate r p)) 
      ) 
    ) 
  ) 
  (reverse r) 
)

XDSoft · 发表于 2013-5-24 19:06:38

牢固发表于 2013-5-24 10:59
搞清楚了XCLIP剪裁边界的内在机制，下面要重新修改剪裁块的边界就很容易了。我们来看，11楼的代码由剪裁块 ...

精彩的应用，这样做，要比用命令做效率快的多。

kery8605 · 发表于 2013-6-3 18:21:48

好好学习牛人太多了

/db_自贡黄明儒_ · 发表于 2013-7-6 15:31:57

G版研究这么深入，是不是可以写一个完美的局部放大程序了？

newer · 发表于 2013-9-23 00:12:39

顶一下。

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

[研讨] 关于如何计算XClip剪裁边界顶点坐标的研究

点评

评分