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

Lisper · 发表于 2013-5-22 21:28:23

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

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

×

我们知道，对于图块的边界剪裁，可以使用XClip命令，使得剪裁边界之外的部分不可见！我们可以使用命令XClip-> P 选项，生成多段线，通过计算生成的多段线得到剪裁边界的坐标！
其实这个剪裁边界的坐标是储存在ACAD_XDICTIONARY词典里的，通过如下代码可获得剪裁边界数据：

(defun GetSpatialFilter (ename / Data Dict tempDict)
; Get the xclip boundry
(if
(and
(setq Data (entget ename))
(setq Dict (cdr (assoc 360 Data)))
(setq tempDict (dictsearch Dict "ACAD_FILTER"))
(setq tempDict (dictsearch (cdr (assoc -1 tempDict)) "SPATIAL"))
)
(cons '(0 . "SPATIAL_FILTER") (member (assoc 100 tempDict) tempDict))
)
)
;;测试
(GetSpatialFilter (car(entsel "\n选择剪裁块：")))
;;返回
((0 . "SPATIAL_FILTER") (100 . "AcDbFilter") (100 . "AcDbSpatialFilter")
(70 . 4) (10 44.1073 36.0989 0.0) (10 44.1073 77.113 0.0) (10 91.0409 77.113
0.0) (10 91.0409 36.0989 0.0) (210 0.0 0.0 1.0) (11 0.0 0.0 0.0) (71 . 1) (72 .
0) (73 . 0) (40 . 1.0) (40 . 0.0) (40 . 0.0) (40 . -62.7683) (40 . 0.0) (40 .
1.0) (40 . 0.0) (40 . -54.9313) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 0.0) (40
. 1.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 0.0) (40 .
0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 0.0))

(defun GetSpatialFilter (ename / Data Dict tempDict) 
    ; Get the xclip boundry 
    
    (if 
        (and 
            (setq Data (entget ename)) 
            (setq Dict (cdr (assoc 360 Data))) 
            (setq tempDict (dictsearch Dict "ACAD_FILTER")) 
            (setq tempDict (dictsearch (cdr (assoc -1 tempDict)) "SPATIAL")) 
        ) 
        (cons '(0 . "SPATIAL_FILTER") (member (assoc 100 tempDict) tempDict)) 
    ) 
) 
;;测试 
(GetSpatialFilter (car(entsel "\n选择剪裁块："))) 
;;返回 
((0 . "SPATIAL_FILTER") (100 . "AcDbFilter") (100 . "AcDbSpatialFilter") 
(70 . 4) (10 44.1073 36.0989 0.0) (10 44.1073 77.113 0.0) (10 91.0409 77.113 
0.0) (10 91.0409 36.0989 0.0) (210 0.0 0.0 1.0) (11 0.0 0.0 0.0) (71 . 1) (72 . 
0) (73 . 0) (40 . 1.0) (40 . 0.0) (40 . 0.0) (40 . -62.7683) (40 . 0.0) (40 . 
1.0) (40 . 0.0) (40 . -54.9313) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 0.0) (40 
. 1.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 0.0) (40 . 
0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 0.0))

组码10即为顶点坐标，70为顶点数，后面的组码40好像是应为坐标转换矩阵，具体怎么组成矩阵不太明白！
在网上找了个LeeMac的计算剪裁对象边界顶点坐标的程序如下:

;; http://www.theswamp.org/index.php?topic=39201.0 LeeMac
(defun _XClipBoundary ( ename / __XClipBoundary elist xlist _xang _xnor mxv mxm trp)
;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n
(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)
;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices
(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)
;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix
(defun trp ( m ) (apply 'mapcar (cons 'list m)))
(defun __XClipBoundary ( ename / xdict )
(if
(setq xdict (cdr (assoc 360 (entget ename))))
(__XClipBoundary xdict)
(if
(and
(eq "SPATIAL_FILTER" (cdr (assoc 0 (setq ename (entget ename)))))
(eq 1 (cdr (assoc 71 ename)))
)
(
(lambda ( massoc ) (massoc 10 ename))
(lambda ( key elist / item )
(if (setq item (assoc key elist))
(cons (cdr item) (massoc key (cdr (member item elist))))
)
)
)
)
)
)
(defun __dxf ( key lst ) (cdr (assoc key lst)))
(setq elist (entget ename)
_xang (__dxf 50 elist)
_xnor (__dxf 210 elist)
)
(if (setq xlist (__XClipBoundary ename))
(
(lambda ( matrix )
(
(lambda ( vector )
(mapcar
(function
(lambda ( point )
(mapcar '+ (mxv matrix point) vector)
)
)
xlist
)
)
(mapcar '- (trans (__dxf 10 elist) _xnor 0)
(mxv matrix
(__dxf 10 (tblsearch "BLOCK" (__dxf 2 elist)))
)
)
)
)
(mxm
(mapcar
(function
(lambda ( v ) (trans v 0 _xnor t))
)
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
(mxm
(list
(list (cos _xang) (sin (- _xang)) 0.0)
(list (sin _xang) (cos _xang) 0.0)
(list 0.0 0.0 1.0)
)
(list
(list (__dxf 41 elist) 0.0 0.0)
(list 0.0 (__dxf 42 elist) 0.0)
(list 0.0 0.0 (__dxf 43 elist))
)
)
)
)
)
)

;; <a href=\"http://www.theswamp.org/index.php?topic=39201.0\" target=\"_blank\">http://www.theswamp.org/index.php?topic=39201.0</a> LeeMac 
(defun _XClipBoundary ( ename / __XClipBoundary elist xlist _xang _xnor mxv mxm trp) 
;; Matrix x Vector - Vladimir Nesterovsky 
;; Args: m - nxn matrix, v - vector in R^n 
 
(defun mxv ( m v ) 
    (mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m) 
) 
 
;; Matrix x Matrix - Vladimir Nesterovsky 
;; Args: m,n - nxn matrices 
 
(defun mxm ( m n ) 
    ((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n)) 
) 
 
;; Matrix Transpose - Doug Wilson 
;; Args: m - nxn matrix 
 
(defun trp ( m ) (apply 'mapcar (cons 'list m))) 
 
    (defun __XClipBoundary ( ename / xdict ) 
        (if 
            (setq xdict (cdr (assoc 360 (entget ename)))) 
            (__XClipBoundary xdict) 
            (if 
                (and 
                    (eq "SPATIAL_FILTER" (cdr (assoc 0 (setq ename (entget ename))))) 
                    (eq 1 (cdr (assoc 71 ename))) 
                ) 
                ( 
                    (lambda ( massoc ) (massoc 10 ename)) 
                    (lambda ( key elist / item ) 
                        (if (setq item (assoc key elist)) 
                            (cons (cdr item) (massoc key (cdr (member item elist)))) 
                        ) 
                    ) 
                ) 
            ) 
        ) 
    ) 
 
    (defun __dxf ( key lst ) (cdr (assoc key lst))) 
 
    (setq elist (entget ename) 
          _xang (__dxf  50 elist) 
          _xnor (__dxf 210 elist) 
    ) 
    (if (setq xlist (__XClipBoundary ename)) 
        ( 
            (lambda ( matrix ) 
                ( 
                    (lambda ( vector ) 
                        (mapcar 
                            (function 
                                (lambda ( point ) 
                                    (mapcar '+ (mxv matrix point) vector) 
                                ) 
                            ) 
                            xlist 
                        ) 
                    ) 
                    (mapcar '- (trans (__dxf 10 elist) _xnor 0) 
                        (mxv matrix 
                             (__dxf 10 (tblsearch "BLOCK" (__dxf 2 elist))) 
                        ) 
                    ) 
                ) 
            ) 
            (mxm 
                (mapcar 
                    (function 
                        (lambda ( v ) (trans v 0 _xnor t)) 
                    ) 
                   '( 
                        (1.0 0.0 0.0) 
                        (0.0 1.0 0.0) 
                        (0.0 0.0 1.0) 
                    ) 
                ) 
                (mxm 
                    (list 
                        (list (cos _xang) (sin (- _xang)) 0.0) 
                        (list (sin _xang) (cos _xang)     0.0) 
                        (list 0.0         0.0             1.0) 
                    ) 
                    (list 
                        (list (__dxf 41 elist) 0.0 0.0) 
                        (list 0.0 (__dxf 42 elist) 0.0) 
                        (list 0.0 0.0 (__dxf 43 elist)) 
                    ) 
                ) 
            )             
        ) 
    ) 
)

这个程序计算的剪裁边界的顶点坐标好像也不对！
请大家来研讨一下，如何求得如下图的剪裁边界顶点坐标？

上图2、3、4是由1复制而来，然后进行旋转或缩放，由函数GetSpatialFilter 得到的顶点坐标数据完全一样！怎样才能求出这些剪裁块的顶点坐标呢？

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:xclip.rar
下载次数:50 文件大小:25.97 KB
下载权限: 不限以上 [免费赚D豆]

DWG测试图

请各位高人来指点指点！O(∩_∩)O谢谢！

牢固 · 发表于 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) 
)

牢固 · 发表于 2013-5-23 23:20:13

本帖最后由牢固于 2013-5-23 23:46 编辑

剪裁块的剪裁边界开关通用函数:

;;(gxl-EnableXclip ename Flag) 开关剪裁块边界,
;; ename = 剪裁块图元
;; Flag = 1 打开， = 0 关闭
;;(gxl-EnableXclip (car(entsel)) 1) ;_ Flag修剪边界
(defun gxl-EnableXclip (ename Flag / IsXClip el)
;;判断图元是否为剪裁块
(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 (setq el (IsXClip ename))
(progn
(entmod (subst (cons 71 Flag) (assoc 71 el) el))
(entupd ename)
)
)
)
;;测试命令
;;关闭修剪
(defun c:tt ()
(while
(setq e (car (entsel "\n选择剪裁块:")))
(gxl-EnableXclip e 0)
)
(princ)
)
;;打开剪裁边界
(defun c:tt ()
(while
(setq e (car (entsel "\n选择剪裁块:")))
(gxl-EnableXclip e 1)
)
(princ)
)

;;(gxl-EnableXclip ename Flag) 开关剪裁块边界, 
;; ename = 剪裁块图元 
;; Flag = 1  打开， = 0 关闭 
;;(gxl-EnableXclip (car(entsel)) 1) ;_ Flag修剪边界 
(defun gxl-EnableXclip (ename Flag / IsXClip el) 
  ;;判断图元是否为剪裁块 
  (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 (setq el (IsXClip ename)) 
    (progn 
    (entmod (subst (cons 71 Flag) (assoc 71 el) el)) 
    (entupd ename) 
    ) 
    ) 
  ) 
;;测试命令 
;;关闭修剪 
(defun c:tt () 
  (while 
    (setq e (car (entsel "\n选择剪裁块:"))) 
  (gxl-EnableXclip e 0) 
    ) 
  (princ) 
  ) 
;;打开剪裁边界 
(defun c:tt () 
  (while 
    (setq e (car (entsel "\n选择剪裁块:"))) 
  (gxl-EnableXclip e 1) 
    ) 
  (princ) 
  )

牢固 · 发表于 2013-5-23 22:49:05

XDSoft 发表于 2013-5-23 21:38
AutoCAD允许用户Filter被引用对象

Filter通过抽象类AcDbFilter类实现，根 ...

看了这篇高论，才真正了解了Xclip到底是怎么工作的！才知道判断是不是剪裁块时不光要判断出"SPATIAL_FILTER"对象，还要判断该对象的71组码是否为1，若71组码为0，则剪裁块不被剪裁！
根据这个原理，我们很容易通过修改71组码值就能移除剪裁块的剪裁状态，而不必通过XClip命令来修改剪裁块的剪裁状态！

登录/注册后可看大图

[pcode=lisp,true];;移除剪裁块的剪裁边界
;;(gxl-RemoveXclip (car(entsel)))
(defun gxl-RemoveXclip (ename / IsXClip el)
  ;;判断图元是否为剪裁块
  (defun IsXClip (ename / xdict)
(if
   (setq xdict (cdr (assoc 360 (entget ename))))
   (IsXClip xdict)
   (if
      (and
         (eq "SPATIAL_FILTER"
            (cdr (assoc 0 (setq ename (entget ename))))
            )
         (eq 1 (cdr (assoc 71 ename)))
         )
      ename
      )
   )
)
  (if (setq el (IsXClip ename))
(progn
(entmod (subst (cons 71 0) (cons 71 1) el))
(entupd ename)
)
)
  )
;;测试命令
(defun c:tt ()
  (while
(setq e (car (entsel "\n选择剪裁块:")))
  (gxl-RemoveXclip e)
)
  (princ)
  )[/pcode]

Lispboy · 发表于 2013-5-22 22:13:20

本帖最后由 Lispboy 于 2013-5-22 22:16 编辑

QQ截图20130522220937.png

[pcode=lisp,true]
(defun get-xclip-pnt ( ename / ename2 data )
(while (setq ename2 (cdr (assoc 360 (entget ename)))) (setq ename ename2))

(if (member '(0 . "SPATIAL_FILTER") (setq data (entget ename)))
      (cons
         (eq 1 (cdr (assoc 71 data)))
         (apply 'append
            (mapcar
                  (function (lambda ( x ) (if (eq 10 (car x)) (list (cdr x)))))
                  data
            )
         )
      )
)
)
[/pcode]

(setq a (get-xclip-pnt (car (entsel))))
选择对象: (T (1117.1 700.739 0.0) (1117.1 620.156 0.0) (1058.16 620.156 0.0)
(1058.16 508.579 0.0) (1303.21 508.579 0.0) (1303.21 397.002 0.0) (955.798
397.002 0.0) (955.798 700.739 0.0))

Lisper · 发表于 2013-5-22 22:38:25

Lispboy 发表于 2013-5-22 22:13
(defun get-xclip-pnt ( ename / ename2 data )
(while (setq ename2 (cdr (assoc 360 (entget ...

这个结果是错误的，并不是剪裁边界的真正坐标位置！示例中1 2 3 4得到的坐标是一样的！

userzhl · 发表于 2013-5-22 22:53:44

[pcode=lisp,true];; Based on code by John Uhden 4/16/2005.
;; Argument: a block reference ename or vla-object.
;; Returns: the xclip boundary WCS point list if the block is clipped,
;; otherwise nil.
(defun getclipboundary (obj / xdict filter spatial elst ptlst)
  (if (= (type obj) 'ename)
(setq obj (vlax-ename->vla-object obj))
  )
  (setq elst (vl-catch-all-apply '(lambda ()
      (setq xdict (vla-getextensiondictionary obj))
      (setq filter (vla-getobject xdict "ACAD_FILTER"))
      (setq spatial (vla-getobject filter "SPATIAL"))
      (entget (vlax-vla-object->ename spatial))
   )
      )
  )          ; (princ elst)
         ; (princ "n")
  (if (not (vl-catch-all-error-p elst))
(foreach x elst
   (if (eq 10 (car x))
(setq ptlst (cons (cdr x) ptlst))
   )
)
  )
  ptlst
)

[/pcode]

Lispboy · 发表于 2013-5-22 23:03:35

Lisper 发表于 2013-5-22 22:38
这个结果是错误的，并不是剪裁边界的真正坐标位置！示例中1 2 3 4得到的坐标是一样的！

应该有矩阵转换在里面，我研究研究。

Lisper · 发表于 2013-5-22 23:04:23

userzhl 发表于 2013-5-22 22:53
;; Based on code by John Uhden 4/16/2005.
;; Argument: a block reference ename or vla-object.
;; R ...

代码和二楼的结果一样，只是得到了词典里的顶点坐标，并不是实际边界坐标！

Lispboy · 发表于 2013-5-22 23:09:46

Lisper 发表于 2013-5-22 23:04
代码和二楼的结果一样，只是得到了词典里的顶点坐标，并不是实际边界坐标！

得先确定词典里面的坐标到底是什么坐标？我把图块移动到0,0,0插入，得到的结果也不是。

Lisper · 发表于 2013-5-22 23:18:53

Lispboy 发表于 2013-5-22 23:09
得先确定词典里面的坐标到底是什么坐标？我把图块移动到0,0,0插入，得到的结果也不是。

原始剪裁的xclip,词典中坐标数据就是边界，但是进行平移后就不对了！词典数据和原始剪裁块一样，这个就很奇怪，不知道机关在哪儿？

snsj · 发表于 2013-5-23 11:01:26

那个储存左边是创建CLIP时候的坐标信息，可惜XCLIP的轮廓CAD没有提供太多的信息，而且一炸开轮廓自动消失，但是也不是完全没有办法：提供一个思路可以用WMFout wmfin的方法，再与XCLIP储存的那个轮廓进行融合，不过会有一些小的误差

Free-Lancer · 发表于 2013-5-23 14:57:12

DXF Code 40 是这样解释的

按列主要次序写出的 4x3 转换矩阵。此矩阵是原始块参照（插入图元）转换的反向矩阵。原始块参照转换是重生成块参照时（始终为 12 个条目）适用于块中所有图元的参照

这个边界应该是对应 Blockdef 后有个矩阵转换而来

牢固 · 发表于 2013-5-23 16:13:13

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

;;计算XCLIP的边框 By Gu_xl 2013.05.23
;;关于矩阵计算函数参见高飞鸟的帖子，Lisp论矩阵

(defun c:tt (/ E EE EL PL DXF40 N EEL SCALE ROTATE MOVE M0 M1)
(setq e (car (entsel)))
(setq ee e)
(while (setq e (cdr (assoc 360 (setq el (entget e))))))
(if (and (= "SPATIAL_FILTER" (cdr (assoc 0 el)))
(= 1 (cdr (assoc 71 el)))
)
(progn
(setq pl (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) el))
dxf40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) el)
n (cdr (assoc 70 el))
eel (entget ee)
scale (list (cdr (assoc 41 eel)) (cdr (assoc 42 eel)) (cdr (assoc 43 eel)))
rotate (cdr (assoc 50 eel))
move (cdr (assoc 10 eel))
) (if (= 1 (cdr (assoc 72 el))) (setq dxf40 (cdr dxf40)))
(setq m0
(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)
)
)
(if (= 2 n)
(setq pl
(list (car pl)
(list (caar pl) (cadadr pl) (caddar pl))
(cadr pl)
(list (caadr pl) (cadar pl) (caddar pl))
)
)
pl
)
(setq m1 (apply 'MAT:DISPTOMATRIX (MAT:RefGeom ee)))
(setq
pl (mapcar '(lambda (x) (mat:mxp (mat:mxm m1 m0) x))
pl
)
)
;;绘制边框
(command "pline")
(foreach a pl (command "_non" (trans a 0 1)))
(command "c")
(princ)
)
)
)

(defun c:tt (/ E EE EL PL DXF40 N EEL SCALE ROTATE MOVE M0 M1) 
  (setq e (car (entsel))) 
  (setq ee e) 
  (while (setq e (cdr (assoc 360 (setq el (entget e)))))) 
  (if (and          (= "SPATIAL_FILTER" (cdr (assoc 0 el))) 
          (= 1 (cdr (assoc 71 el))) 
      ) 
    (progn 
      (setq pl     (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) el)) 
            dxf40  (vl-remove-if-not '(lambda (x) (= (car x) 40)) el) 
            n (cdr (assoc 70 el)) 
            eel (entget ee) 
            scale  (list (cdr (assoc 41 eel)) (cdr (assoc 42 eel)) (cdr (assoc 43 eel))) 
            rotate (cdr (assoc 50 eel)) 
            move   (cdr (assoc 10 eel)) 
            )      (if (= 1 (cdr (assoc 72 el))) (setq dxf40 (cdr dxf40))) 
      (setq m0 
             (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) 
               ) 
            ) 
      (if (= 2 n) 
        (setq pl 
          (list (car pl) 
                (list (caar pl) (cadadr pl) (caddar pl)) 
                (cadr pl) 
                (list (caadr pl) (cadar pl) (caddar pl)) 
                ) 
          ) 
        pl 
        ) 
      (setq m1 (apply 'MAT:DISPTOMATRIX (MAT:RefGeom ee))) 
      (setq 
        pl (mapcar '(lambda (x) (mat:mxp (mat:mxm m1 m0) x)) 
                   pl 
                   ) 
        ) 
      ;;绘制边框 
      (command "pline") 
      (foreach a pl (command "_non" (trans a 0 1))) 
      (command "c") 
      (princ) 
      ) 
    ) 
  )

XDSoft · 发表于 2013-5-23 21:38:43

AutoCAD允许用户Filter被引用对象

Filter通过抽象类AcDbFilter类实现，根据ObjectARX文档，有两种Filter方式：AcDbLayerFilter和AcDbSpatialFilter。只有AcDbSpatialFilter用于AutoCAD 2000+版本，而层Filter只能在第三方应用程序中用到，或根本不能工作。

空间Filter

空间Filter定义了一个3D空间，这个所谓的剪切空间是由平面多边曲线和与之相关的高度生成的。因此，空间总是N边的棱柱。

如果被引用块容器的所有对象完全包含在这个空间中，就会被显示出来；如果完全不包含在这个空间中，就不会被显示出来。所有其他对象将被分为可视部分（在剪切空间内）和不可视部分（不在剪切空间内）。

AcDbSpatialFilter对象位于块引用对象的扩展词典中，在这个扩展中，可以发现关键字“ACAD_FILTER",它指向另外一个词典，在第二个词典中，用户可通过关键字”SPATIAL"来访问AcDbSpatialFilter对象。

剪切空间是一个拉伸成的平面多边曲线。因此，要定义空间，必须用局部坐标系来定义多边形的平面。这是通过使用平面沿高度的法线方向（在ObjectDBX中）或者平面上的点实现的（在AutoLISP和DXF中）。

ObjectDBX	Activex Automation	DXF/AutoLISP
getDefinition(),normal	n/a	组210
getDefinition(),elavation	n/a	n/a
n/a	n/a	组11，局部坐标系的原点

剪切多边形在该局部坐标系的X/Y平面内，它是通过两个或更多的2D点定义的。如果只有两个点，则这两个点定义了一个矩形。

也许你会说，两个点在任何平面可以定义许多矩形。是的，至少还需要定义个旋转角度或者矩形的方向。然而由于某种原因，AutoCAD不记录这样的旋转。相反，它记录引用块的坐标系和局部坐标系之间的整个转换矩阵（换句话说，定义在组码40的矩阵是剪切空间坐标系到引用块的变换矩阵）。

转换矩阵是个4*4的矩阵，每个源点与矩阵相乘，以获得转换点（转换到块定义坐标系），每个点按下式计算： p1=T*p

因为这种转换矩阵的最后一行总是(0 0 0 1)，所以AutoCAD只记录前三行。在DXF和AutoLISP中，会发现如下顺序列出的12个数值：第一行从左到右，第二行从左到右，第三行从左到右。

ObjectDBX	Activex Automation	DXF/AutoLISP
n/a	n/a	组40,局部坐标系转换矩阵

回顾剪切多边形。现在已经有了局部坐标系，多边形要么由两个2D点定义（创建一个平行于坐标系的矩形），要么由任意多的2D点构成。在第二种情况下，点由直线顺序地连接起来，形成封闭的多边形。

ObjectDBX	Activex Automation	DXF/AutoLISP
n/a	n/a	组70,点的数量
getDefinition(),points	n/a	组10

与剪切平面相垂直，剪切空间可以在一个或两个方向上有边界，也可以两个方向上都没有边界。每个边界是通过到平面的距离给定的，沿法线方向测量。

ObjectDBX	Activex Automation	DXF/AutoLISP
n/a	n/a	组72，有上边界
getDefinition(),frontClip	n/a	组40，上边界距离
n/a	n/a	组73，有下边界
n/a	n/a	组41，下边界距离

不是每个块插入都被过滤，即使扩展词典指向一个AcDbSpatialFilter对象也是如此，一个单独的标志指出显示是否应该被剪切。

ObjectDBX	Activex Automation	DXF/AutoLISP
getDefinition(),enabled	n/a	组71

剪切多边形和它的上下边界都是以引用块的坐标系统表示的。任何转换、旋转、缩放和其他类似操作都已经得以应用。（也就是说上面说的局部坐标系的变换矩阵已经包含了引用块的变换）。

在某些情况下，可能会需要计算剪切空间的边角，就像它们出现在被引用块的坐标系一样，事实上，这就是应该产生过滤的地方。要将剪切空间从引用块转换到被引用块，需要做与插入块相反的工作。

按数学术语来说，我们需要所有转换的逆，或最终块转换矩阵的逆。在DXF和AutoLISP中，这个逆转换矩阵在另外一套12组40值中。就如同前面介绍的矩阵，第四行包含（0 0 0 1），也被忽略了。（这主要是在AUTOCAD最初硬件很紧张情况下为了节省存储空间）。

ObjectDBX	Activex Automation	DXF/AutoLISP
n/a	n/a	组40，逆块转换矩阵

总结：

对于一个典型的SPATIAL_FILTER的entget数据结构：

((0 . "SPATIAL_FILTER") (100 . "AcDbFilter") (100 . "AcDbSpatialFilter") (70 .
4) (10 415.361 83.0325 0.0) (10 480.678 83.0325 0.0) (10 480.678 15.6616 0.0)
(10 415.361 15.6616 0.0) (210 0.0 0.0 1.0) (11 0.0 0.0 0.0) (71 . 1) (72 . 0)
(73 . 0) (40 . -0.61694) (40 . -0.78701) (40 . 0.0) (40 . 319.661) (40 .
0.78701) (40 . -0.61694) (40 . 0.0) (40 . -314.787) (40 . 0.0) (40 . 0.0) (40 .
1.0) (40 . 0.0) (40 . 1.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 .
1.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0) (40 . 0.0))

复制代码

解释如下：

AcDbSpaitalFilter的DXF类名是“SPATIAL_FILTER"。接在通常的AcDbObject组后面的是子类标识，然后是组70，10（重复）、210、11、71、72、40（上边界距离）、73、41、40（局部坐标系转换矩阵，重复12次）、和40（逆块转换，重复12次）。

应用实例：

求下图XCLIP的边界

QQ截图20130523211315.png

[pcode=lisp,true]
(defun GetSpatialFilter (ename / Data Dict tempDict)
; Get the xclip boundry
(if
      (and
         (setq Data (entget ename))
         (setq Dict (cdr (assoc 360 Data)))
         (setq tempDict (dictsearch Dict "ACAD_FILTER"))
         (setq tempDict (dictsearch (cdr (assoc -1 tempDict)) "SPATIAL"))
      )
      (cons '(0 . "SPATIAL_FILTER") (member (assoc 100 tempDict) tempDict))
)
)
[/pcode]

获得块的SpatialFilter数据

命令: (setq a (GetSpatialFilter (car (entsel))))
选择对象: ((0 . "SPATIAL_FILTER") (100 . "AcDbFilter") (100 .
"AcDbSpatialFilter") (70 . 4) (10 415.361 83.0325 0.0) (10 480.678 83.0325 0.0)
(10 480.678 15.6616 0.0) (10 415.361 15.6616 0.0) (210 0.0 0.0 1.0) (11 0.0 0.0
0.0) (71 . 1) (72 . 0) (73 . 0) (40 . -0.61694) (40 . -0.78701) (40 . 0.0) (40
. 319.661) (40 . 0.78701) (40 . -0.61694) (40 . 0.0) (40 . -314.787) (40 . 0.0)
(40 . 0.0) (40 . 1.0) (40 . 0.0) (40 . 1.0) (40 . 0.0) (40 . 0.0) (40 . 0.0)
(40 . 0.0) (40 . 1.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 0.0) (40 . 1.0)
(40 . 0.0))

[pcode=lisp,true]
(defun XD::List:GetDataByInterval(l c1 c2 tf / info re x)
(setq re (member (assoc c1 l) (reverse (cdr (member (assoc c2 l) (reverse info))))))
(if tf
 (setq re (mapcar '(lambda(x)(cdr x)) re))
)
re
)
(defun XD::List:GetDataBySums (l c s / d el i)
 (if (and
 (cond
 ((= (type c) 'INT)
 (setq d (assoc c l))
 )
 ((= (type c) 'LIST)
 T
 )
 (t
 nil
 )
 )
 (setq d (member d l))
 )
(progn
 (setq i 0)
 (repeat s
 (setq el (cons (nth i d) el))
 (setq i (1+ i))
 )
)
 )
 (reverse el)
)
(defun XD:GetSpatialInfo (e / _spatialMat bb bound coords d d1 i info mat mat1 mat2 mat3 mat4 normal orin pnt pnts rmat ub zaxis)
 (defun _spatialMat (mat / d d1 i mat1 mat2 mat3 mat4 enabled)
(setq i 0)
(repeat 12
 (setq d (nth i mat))
 (cond
 ((and
 (>= i 0)
 (= i 4)
 (< i 8)
 )
 (setq d1 (cdr d)
 mat2 (cons d1 mat2)
 )
 )
 (t
 (setq d1 (cdr d)
 mat3 (cons d1 mat3)
 )
 )
 )
 (setq i (1+ i))
)
(list (reverse mat1) (reverse mat2) (reverse mat3) '(0.0 0.0 0.0 1.0))
 )
 (if (setq info (GetSpatialFilter e))
(progn
 (setq orin (cdr (assoc 11 info)) ; orin (cons "Orin" orin)
 enabled (cdr (assoc 71 info))
 Enabled (cons "Enabled" enabled)
 normal (assoc 210 info)
 zAxis (cons "zAxis" (cdr (assoc 210 info)))
 Coords (cons "Coords" (list orin (cdr zAxis)))
 pnts (assoc 70 info)
 pnt (list "PntSums" (cdr pnts))
 pnts (XD::List:GetDataByInterval info 70 210 t)
 pnts (cons "Pnts" (cdr pnts))
 uB (cdr (assoc 72 info))
 ub (cond
 ((= 72 1)
 (cdr (cdr (member uB info)))
 )
 (t
 0.0
 )
 )
 bB (cdr (assoc 73 info))
 bb (cond
 ((= 73 1)
 (cdr (cdr (member bB info)))
 )
 (t
 0.0
 )
 )
 bound (list "Bound" ub bb)
 mat (XD::List:GetDataBySums info 40 24)
 mat1 (XD::List:GetDataBySums mat 40 12)
 mat2 (reverse (XD::List:GetDataBySums (reverse mat) 40 12))
 mat1 (_spatialMat mat1)
 Mat (cons "Mat" mat1)
 mat2 (_spatialMat mat2)
 rMat (cons "rMat" mat2)
 )
)
 )
 (list Enabled Coords pnt pnts bound mat rmat)
)[/pcode]

QQ截图20130523211245.png

1、函数GetSpatialInfo获得块XCLIP的基本信息,关联表：

Enabled---裁剪是否启用
coords---局部坐标系（原点，Z轴）
PntSums-- 剪切多边形顶点数（如果是2，我们还需计算出矩形的4个顶点）
Pnts-----多边形顶点表（定义在局部坐标系下）
Bound---上下边界数据，0表示无边界
Mat----剪切空间局部坐标系到块定义的转换矩阵
rMat---逆块矩阵

通用纯LISP函数，见附件

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:GetSpatialFilter.lsp
下载次数:35 文件大小:3.92 KB
下载权限: 不限以上 [免费赚D豆]

[pcode=lisp,true]命令: (setq info (XD:GetSpatialInfo e))
(("Enabled" . 1) ("Coords" (0.0 0.0 0.0) (0.0 0.0 1.0)) ("PntSums" 4) ("Pnts"
(415.361 83.0325 0.0) (480.678 83.0325 0.0) (480.678 15.6616 0.0) (415.361
15.6616 0.0)) ("Bound" 0.0 0.0) ("Mat" (-0.61694 -0.78701 0.0 319.661) (0.78701
-0.61694 0.0 -314.787) (0.0 0.0 1.0 0.0) (0.0 0.0 0.0 1.0)) ("rMat" (1.0 0.0
0.0 0.0) (0.0 1.0 0.0 0.0) (0.0 0.0 1.0 0.0) (0.0 0.0 0.0 1.0)))

[/pcode]

典型数据如下：

[pcode=lisp,true]命令: (setq pnts (cdr (assoc "Pnts" info)))
((415.361 83.0325 0.0) (480.678 83.0325 0.0) (480.678 15.6616 0.0) (415.361
15.6616 0.0))
[/pcode]
2、我们用上面的四个点画出剪切空间的多边形，上图的黄线。

[pcode=lisp,true]命令: (setq mat (cdr (assoc "Mat" info)))
((-0.61694 -0.78701 0.0 319.661) (0.78701 -0.61694 0.0 -314.787) (0.0 0.0 1.0
0.0) (0.0 0.0 0.0 1.0))[/pcode]

[pcode=lisp,true]
(setq pnts1 ($xdlsp_points_transform pnts mat))
((-1.93974 -39.1196 0.0) (-42.2365 12.2856 0.0) (10.7852 53.8495 0.0) (51.0819
2.44432 0.0))
[/pcode]

3、得到剪切空间到块定义的变换矩阵，矩阵作用到上面的四个点，得到红色的多边形，这个转换到块定义的坐标系了。

[pcode=lisp,true]命令: (setq mat_blk2wcs (xdrx_matrix_block2wcs e))
((-0.61694 1.57402 0.0 322.162) (-0.78701 -1.23388 0.0 218.892) (0.0 0.0 1.0
0.0) (0.0 0.0 0.0 1.0))
[/pcode]

4、上面代码得到块定义到模型空间块引用（INSERT）实体的变换矩阵，作用上面红色四个点，得到模型空间的最终的“裁剪边界”。

[pcode=lisp,true]
(setq pnts2 ($xdlsp_points_transform pnts1 mat_blk2wcs))
((261.784 268.688 0.0) (367.557 236.974 0.0) (400.269 143.96 0.0) (294.495
175.674 0.0))

[/pcode]

有了上面的分析和写的LISP函数，写个测试命令就很简单了，矩阵变换可以使用高飞鸟版主的矩阵函数，我使用了XDRX_API的矩阵函数做演示

登录/注册后可看大图

[pcode=lisp,true]
(defun c:tt ( / clr e info mat1 mat2 p1 p2 p3 p4 pnts pnts1 pnts2 v)
  (defun _dl (pnts clr)
(apply
   'command
   (cons "pline" pnts)
)
(command "c")
(xdrx_polyline_setconstantwidth (entlast) 4.0)
(xdrx_entity_setcolor (entlast) clr)
  )
  (if (setq e (car (entsel)))
(progn
   (setq info (xd:getspatialinfo e)
         pnts (cdr (assoc "Pnts" info)) ; 得到剪切空间的点表
         mat1 (cdr (assoc "Mat" info)) ; 得到剪切空间到块容器坐标系的变换矩阵
         mat2 (xdrx_matrix_block2wcs e) ; 得到块容器坐标系到世界坐标系的变换矩阵
   )
   (if (= 2 (length pnts))             ; 如果是2点，算出矩形
      (progn
      (setq p1 (car pnts1)
            p3 (cadr pnts1)
            v (mapcar '- p3 p1)
            p2 (mapcar '+ p1 (list (car v) 0 0))
            p4 (mapcar '+ p1 (list 0 (cadr v) 0))
            pnts (list p1 p2 p3 p4)
      )
      )
   )
   (_dl pnts 2) ;;画剪切空间多边形
   (setq pnts1 ($xdlsp_points_transform pnts mat1)) ; 剪切空间点变换到块空间
   (_dl pnts1 1);;画块定义空间裁剪多边形
   (setq pnts2 ($xdlsp_points_transform pnts1 mat2))       ; 块空间点变换到模型空间块引用
   (_dl pnts2 6);;画模型空间INSERT最终裁剪边界
)
  )
  (princ)
)

[/pcode]

Lispboy · 发表于 2013-5-23 22:39:29

WOW,这矩阵太神奇，文章太经典。

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

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

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

评分

本帖被以下淘专辑推荐:

点评

评分

评分

评分

评分

评分

评分

浏览过的版块