坐标变换法求块参照与曲线的交点， 向highflybird学习致敬!

zjupxw

    国庆就要过去三天了，这三天一直在学习highflybird的坐标变换，刚开始云里雾里，慢慢的有了些思绪，模仿者写了个求块参照（当前仅适于用等比缩放的块参照）与曲线（直线、多段线等）的交点的子程序，调试了一下，效果还不错，特跟大家分享，向highflybird学习致敬!
    该子程序要调用highflybird的Matrix-Lib的子程序集，大家可到链接：http://bbs.mjtd.com/forum.php?mod=viewthread&tid=99926&extra=page%3D1%26filter%3Dtypeid%26typeid%3D108%26t ypeid%3D108 去下载！

2. (defun  Get-line-block-intersect (line block Acdblist inter_model / matrix Revmatrix result intersect_lst intersect_pnt)
   
3.   (if   (not(eq (type line) 'VLA-OBJECT)) (setq line (vlax-ename->vla-object line)) )                  ;转换line类型
   
4.   (if   (eq (type block) 'VLA-OBJECT) (setq block (vlax-vla-object->ename block)) )                  ;转换block类型
   
5.   (if   (and (eq (vla-get-objectname (vlax-ename->vla-object block)) "AcDbBlockReference" )              ;判断是否等比缩放矩阵
   
6.        (equal (abs(cdr (assoc 41 (entget block)))) (abs(cdr (assoc 42 (entget block)))) 1e-8)
   
7.        (equal (abs(cdr (assoc 42 (entget block)))) (abs(cdr (assoc 43 (entget block)))) 1e-8)
   
8.     )
   
9.     (progn
   
10.       (setq matrix (Mat:DispToMatrix (car (MAT:RefGeom block)) (last (MAT:RefGeom block))) )           ;图块的变换矩阵        
    
11.       (setq Revmatrix (Mat:DispToMatrix (car (MAT:RevRefGeom block)) (last (MAT:RevRefGeom block)) )  )   ;图块的逆变换矩阵
    
12.       (vla-TransformBy line (vlax-tmatrix Revmatrix) )                              ;将直线进行逆变换以求交点
    
13.       (vlax-for obj  (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)) ) (cdr(assoc 2 (entget block))) )
    
14.         (cond  (   (member (vla-get-ObjectName obj) Acdblist)
    
15.               (setq intersect_lst (append (vlax-invoke line 'intersectwith obj inter_model) intersect_lst) )    ;调用intersectwith方法求交点
    
16.             )
    
17.             (  (eq (vla-get-ObjectName obj) "AcDbBlockReference" )                    ;递归调用处理块中块
    
18.               (setq intersect_pnt (append (Get-line-block-intersect line obj Acdblist inter_model) intersect_pnt) );将递归结果放入 intersect_pnt去再次变换
    
19.             )
    
20.         )
    
21.       )
    
22.       (if   intersect_lst (setq intersect_pnt (append (Intersect-pnt-Handle intersect_lst) intersect_pnt) ) )      ;交点的结果为一维表，将其转化为三维的点列表
    
23.       (if  intersect_pnt (setq result (mapcar '(lambda(p) (MAT:mxp matrix p) ) intersect_pnt) ) )        ;将求得的交点变换为实际交点
    
24.       (vla-TransformBy line (vlax-tmatrix matrix) )                              ;将曲线（直线）变换回去
    
25.           (progn
    
26.        (if  (not (eq (vla-get-ObjectName (vlax-ename->vla-object block)) "AcDbBlockReference" ) )
    
27.          (setq result (vlax-invoke line 'intersectwith block inter_model) )                    ;非图块直接求交点
    
28.        )   
    
29.      )
    
30.   )                                                     
    
31. )

(defun  Get-line-block-intersect (line block Acdblist inter_model / matrix Revmatrix result intersect_lst intersect_pnt)<br />   (if   (not(eq (type line) 'VLA-OBJECT)) (setq line (vlax-ename->vla-object line)) )                  ;转换line类型<br />   (if   (eq (type block) 'VLA-OBJECT) (setq block (vlax-vla-object->ename block)) )                  ;转换block类型<br />   (if   (and (eq (vla-get-objectname (vlax-ename->vla-object block)) "AcDbBlockReference" )              ;判断是否等比缩放矩阵<br />        (equal (abs(cdr (assoc 41 (entget block)))) (abs(cdr (assoc 42 (entget block)))) 1e-8) <br />        (equal (abs(cdr (assoc 42 (entget block)))) (abs(cdr (assoc 43 (entget block)))) 1e-8) <br />     )<br />     (progn<br />       (setq matrix (Mat:DispToMatrix (car (MAT:RefGeom block)) (last (MAT:RefGeom block))) )           ;图块的变换矩阵        <br />       (setq Revmatrix (Mat:DispToMatrix (car (MAT:RevRefGeom block)) (last (MAT:RevRefGeom block)) )  )   ;图块的逆变换矩阵<br />       (vla-TransformBy line (vlax-tmatrix Revmatrix) )                              ;将直线进行逆变换以求交点<br />       (vlax-for obj  (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)) ) (cdr(assoc 2 (entget block))) )<br />         (cond  (   (member (vla-get-ObjectName obj) Acdblist)<br />               (setq intersect_lst (append (vlax-invoke line 'intersectwith obj inter_model) intersect_lst) )    ;调用intersectwith方法求交点<br />             )<br />             (  (eq (vla-get-ObjectName obj) "AcDbBlockReference" )                    ;递归调用处理块中块<br />               (setq intersect_pnt (append (Get-line-block-intersect line obj Acdblist inter_model) intersect_pnt) );将递归结果放入 intersect_pnt去再次变换<br />             )<br />         )<br />       )<br />       (if   intersect_lst (setq intersect_pnt (append (Intersect-pnt-Handle intersect_lst) intersect_pnt) ) )      ;交点的结果为一维表，将其转化为三维的点列表<br />       (if  intersect_pnt (setq result (mapcar '(lambda(p) (MAT:mxp matrix p) ) intersect_pnt) ) )        ;将求得的交点变换为实际交点<br />       (vla-TransformBy line (vlax-tmatrix matrix) )                              ;将曲线（直线）变换回去<br />           (progn<br />        (if  (not (eq (vla-get-ObjectName (vlax-ename->vla-object block)) "AcDbBlockReference" ) )<br />          (setq result (vlax-invoke line 'intersectwith block inter_model) )                    ;非图块直接求交点<br />        )   <br />      )<br />   )                                                     <br /> )

样例: (Get-line-block-intersect line block '("AcDbLine" "AcDbPolyline" "AcDbCircle" "AcDbArc") acExtendnone)
其中 line block参数既可以是图元也可以是VLA对象，上述样例中用于求图库中("AcDbLine" "AcDbPolyline" "AcDbCircle" "AcDbArc")  类型的组件与line的实际交点（acExtendnone）
程序每行写的有些太长，帖子中直接看上去不太好看，但放到EverEdit编辑器中，看着效果还可以的! ^_^

vlisp2012

很好的程序，学习了。

zjupxw

忘记后面跟着的一段子程序了，Sorry！

2. ;;本子程序用于处理一维交点程序点至三维交点
   
3. (defun Intersect-pnt-Handle ( intersect_pnt_lst / result_pnt_lst )
   
4.         (if  intersect_pnt_lst
   
5.                   (progn
   
6.                           (repeat (/ (length  intersect_pnt_lst) 3)
   
7.                                 (setq result_pnt_lst (cons (list (car  intersect_pnt_lst) (cadr  intersect_pnt_lst) (caddr  intersect_pnt_lst)) result_pnt_lst)  
   
8.                                          intersect_pnt_lst (cdddr intersect_pnt_lst)
   
9.                                 )               
   
10.                         )
    
11.                 )
    
12.         )
    
13.         (reverse result_pnt_lst)
    
14. )

;;本子程序用于处理一维交点程序点至三维交点<br /> (defun Intersect-pnt-Handle ( intersect_pnt_lst / result_pnt_lst )<br />         (if  intersect_pnt_lst<br />                   (progn <br />                           (repeat (/ (length  intersect_pnt_lst) 3)<br />                                 (setq result_pnt_lst (cons (list (car  intersect_pnt_lst) (cadr  intersect_pnt_lst) (caddr  intersect_pnt_lst)) result_pnt_lst)  <br />                                          intersect_pnt_lst (cdddr intersect_pnt_lst)<br />                                 )                <br />                         )<br />                 )<br />         )<br />         (reverse result_pnt_lst)<br /> )

自贡黄明儒

手机上看不到你的程序，先猜想一下你是怎么做的。1 首先将曲线变换到块ECS中， 2块内各线与曲线求交点， 3 交点变换到WCS下

zjupxw

又琢磨了大半天，模仿highflybird
http://bbs.mjtd.com/forum.php?mo ... 67&page=1#pid502223《块中图元原位复制》的方法，求得了非等比缩放图块（包括块中块）与直线（曲线）的交点，这样所有的求图块与曲线交点的情况都可以适用，代码如下：

2. (defun Get-line-NoScale-block-intersect(line block Acdblist inter_model / lX lY lZ insert_pt line_blk
   
3.                  mat Revmat ref scmat sX sY sZ trsmat
   
4.                 new *space intersect_lst intersect_pnt result)
   
5.         ;;; 匿名块子程序                                                ;;
   
6.         (defun make-anonymous-block (obj insert_pt / blkobj origin bkName *space)
   
7.                   (setq origin  (vlax-3d-point insert_pt))
   
8.                   (setq blkobj (vla-add (vla-get-blocks *doc) origin "*U"))  
   
9.                   ; Blocks（vla-add object insertionpoint name)
   
10.                   (setq bkName (vla-get-name blkobj))
    
11.                   (vlax-invoke *doc 'copyobjects (list obj) blkobj)   ;把obj拷贝进入匿名块
    
12.                   (vla-Delete obj)                                                                        ;把obj（直线）删除
    
13.                   (if         (zerop (vla-get-ActiveSpace *doc))
    
14.                            (setq *space (vla-get-PaperSpace *doc))
    
15.                            (setq *space (vla-get-modelspace *doc))
    
16.                    )
    
17.                   (vla-insertblock *space origin bkName 1 1 1 0) ;等比插入的匿名块
    
18.                   (vla-put-Explodable blkobj :vlax-true)  ;设置属性为可分解
    
19.                   blkobj
    
20.         )
    
21.         (if         (not(eq (type line) 'VLA-OBJECT)) (setq line (vlax-ename->vla-object line)) )                                                                        
    
22.         ;转换line类型
    
23.         (if         (eq (type block) 'VLA-OBJECT) (setq block (vlax-vla-object->ename block)) )                                                                        
    
24.         ;转换block类型
    
25.         (setq *doc (vla-get-activedocument (vlax-get-acad-object)))
    
26.         (if         (zerop (vla-get-ActiveSpace *doc))
    
27.         (setq *space (vla-get-PaperSpace *doc))
    
28.         (setq *space (vla-get-modelspace *doc))
    
29.     )
    
30.     (vlax-invoke *doc 'copyobjects (list line) *space)                                                                                                                        
    
31.     ;先拷贝曲线
    
32.     (setq Revmat (Mat:DispToMatrix (car (MAT:RevRefGeom block))
    
33.             (last (MAT:RevRefGeom block))) )                ;图块的逆变换矩阵
    
34.     (setq mat (Mat:DispToMatrix (car (MAT:RefGeom block))
    
35.             (last (MAT:RefGeom block))) )                        ;图块的变换矩阵
    
36.     (setq lX (cdr (assoc 41 (entget block))) )                                                                                                                                                
    
37.     (setq lY (cdr (assoc 42 (entget block))) )                                                                                                                                                        
    
38.     (setq lZ (cdr (assoc 43 (entget block))) )                                                                                                                                                
    
39.     (setq sX  (/ 1 lx))         ;非均匀缩放则要取得各个比例值
    
40.     (setq sY  (/ 1 lY))
    
41.     (setq sZ  (/ 1 lZ))
    
42.     (setq sclMat (list (list sX 0 0 0)   ;乘以一个比例缩放矩阵使得比例均匀
    
43.                      (list 0 sY 0 0)
    
44.                      (list 0 0 sZ 0)
    
45.                      (list 0 0  0 1)
    
46.                 )
    
47.     )
    
48.     (setq trsmat (MAT:mxm (InverseMatrix sclMat) Revmat) )                                                                                                
    
49.     ;因为逆变换，所以需 (setq trsmat (MAT:mxm (InverseMatrix sclMat) Revmat) )
    
50.     ; (AB)^-1 =B^-1A^-1 ，原程序是 (setq trsmat (MAT:mxm mat sclMat))
    
51.     (vla-transformby (vlax-ename->vla-object (entlast)) (vlax-tmatrix trsmat))  
    
52.         ;将最后图元（复制直线）逆变换
    
53.     (setq insert_pt (cdr(assoc 10 (entget(tblobjname "block" (cdr(assoc 2 (entget block))) )))) )                                                        
    
54.     ;原图块的基点作为匿名图块的插入点
    
55.     (setq line_blk (make-anonymous-block (vlax-ename->vla-object (entlast)) insert_pt))                                                                        
    
56.     ;得到匿名图块        
    
57.     (setq ref (vlax-ename->vla-object (entlast)))                                                                                                                                            
    
58.     ;最后图块为插入的匿名图块         
    
59.     (vla-put-xscalefactor ref (* (vla-get-xscalefactor ref) sX))                                                                                                                        
    
60.     ;;将匿名图块变换到可求交点的位置
    
61.     (vla-put-yscalefactor ref (* (vla-get-yscalefactor ref) sY))
    
62.     (vla-put-zscalefactor ref (* (vla-get-zscalefactor ref) sZ))
    
63.           (command "explode" (list (vlax-vla-object->ename ref)  insert_pt) )                                                                                                        
    
64.           ;将匿名图块炸开以求交点
    
65.           (setq new (vlax-ename->vla-object (entlast)) )                                                                                                                                          
    
66.           ;最后图块为炸开后得到的直线
    
67.     (vlax-for obj  (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)) )
    
68.                             (cdr(assoc 2 (entget block))) )
    
69.                 (cond        (         (member (vla-get-ObjectName obj) Acdblist)
    
70.                                         (setq intersect_lst (append (vlax-invoke new 'intersectwith obj inter_model) intersect_lst) )               
    
71.                                         ;调用intersectwith方法求交点
    
72.                                 )
    
73.                                 (        (eq (vla-get-ObjectName obj) "AcDbBlockReference" )                                                                                
    
74.                                         ;递归调用处理块中块
    
75.                                 (setq intersect_pnt (append (Get-line-block-intersect new obj Acdblist inter_model) intersect_pnt) )
    
76.                                         ;将递归结果放入 intersect_pnt去再次变换
    
77.                                 )
    
78.                 )
    
79.         )
    
80.         (vla-delete (vlax-ename->vla-object (entlast)))                                                                                                                                         
    
81.         ;删除炸开得到的直线
    
82.         (vla-delete line_blk)                                                                                                                                                                                 
    
83.         ;删除匿名图块
    
84.         (if         intersect_lst (setq intersect_pnt (append (Intersect-pnt-Handle intersect_lst) intersect_pnt) ) )                        
    
85.         ;交点的结果为一维表，将其转化为三维的点列表
    
86.         (if        intersect_pnt (setq result (mapcar '(lambda(p) (MAT:mxp mat p) ) intersect_pnt) ) )                                
    
87.         ;将求得的交点变换为实际交点
    
88.         ;(if         result (NetBee-2dimension-coordinate result (list 0 < >) 0 )        )                                                                        
    
89.         ;调用排序子程序对交点排序，该子程序在论坛的自定义Lisp函数中有，需要的自己去下载
    
90. )

(defun Get-line-NoScale-block-intersect(line block Acdblist inter_model / lX lY lZ insert_pt line_blk<br />                  mat Revmat ref scmat sX sY sZ trsmat <br />                 new *space intersect_lst intersect_pnt result)<br />         ;;; 匿名块子程序                                                ;;<br />         (defun make-anonymous-block (obj insert_pt / blkobj origin bkName *space)<br />                   (setq origin  (vlax-3d-point insert_pt))<br />                   (setq blkobj (vla-add (vla-get-blocks *doc) origin "*U"))  <br />                   ; Blocks（vla-add object insertionpoint name)<br />                   (setq bkName (vla-get-name blkobj))<br />                   (vlax-invoke *doc 'copyobjects (list obj) blkobj)   ;把obj拷贝进入匿名块<br />                   (vla-Delete obj)                                                                        ;把obj（直线）删除<br />                   (if         (zerop (vla-get-ActiveSpace *doc))<br />                            (setq *space (vla-get-PaperSpace *doc))<br />                            (setq *space (vla-get-modelspace *doc))<br />                    )<br />                   (vla-insertblock *space origin bkName 1 1 1 0) ;等比插入的匿名块<br />                   (vla-put-Explodable blkobj :vlax-true)  ;设置属性为可分解<br />                   blkobj<br />         ) <br />         (if         (not(eq (type line) 'VLA-OBJECT)) (setq line (vlax-ename->vla-object line)) )                                                                        <br />         ;转换line类型<br />         (if         (eq (type block) 'VLA-OBJECT) (setq block (vlax-vla-object->ename block)) )                                                                        <br />         ;转换block类型<br />         (setq *doc (vla-get-activedocument (vlax-get-acad-object)))<br />         (if         (zerop (vla-get-ActiveSpace *doc))<br />         (setq *space (vla-get-PaperSpace *doc))<br />         (setq *space (vla-get-modelspace *doc))<br />     )<br />     (vlax-invoke *doc 'copyobjects (list line) *space)                                                                                                                        <br />     ;先拷贝曲线<br />     (setq Revmat (Mat:DispToMatrix (car (MAT:RevRefGeom block)) <br />             (last (MAT:RevRefGeom block))) )                ;图块的逆变换矩阵<br />     (setq mat (Mat:DispToMatrix (car (MAT:RefGeom block)) <br />             (last (MAT:RefGeom block))) )                        ;图块的变换矩阵<br />     (setq lX (cdr (assoc 41 (entget block))) )                                                                                                                                                <br />     (setq lY (cdr (assoc 42 (entget block))) )                                                                                                                                                        <br />     (setq lZ (cdr (assoc 43 (entget block))) )                                                                                                                                                <br />     (setq sX  (/ 1 lx))         ;非均匀缩放则要取得各个比例值<br />     (setq sY  (/ 1 lY))<br />     (setq sZ  (/ 1 lZ))<br />     (setq sclMat (list (list sX 0 0 0)   ;乘以一个比例缩放矩阵使得比例均匀<br />                      (list 0 sY 0 0)<br />                      (list 0 0 sZ 0)<br />                      (list 0 0  0 1)<br />                 )<br />     )<br />     (setq trsmat (MAT:mxm (InverseMatrix sclMat) Revmat) )                                                                                                <br />     ;因为逆变换，所以需 (setq trsmat (MAT:mxm (InverseMatrix sclMat) Revmat) ) <br />     ; (AB)^-1 =B^-1A^-1 ，原程序是 (setq trsmat (MAT:mxm mat sclMat))<br />     (vla-transformby (vlax-ename->vla-object (entlast)) (vlax-tmatrix trsmat))  <br />         ;将最后图元（复制直线）逆变换 <br />     (setq insert_pt (cdr(assoc 10 (entget(tblobjname "block" (cdr(assoc 2 (entget block))) )))) )                                                        <br />     ;原图块的基点作为匿名图块的插入点<br />     (setq line_blk (make-anonymous-block (vlax-ename->vla-object (entlast)) insert_pt))                                                                         <br />     ;得到匿名图块        <br />     (setq ref (vlax-ename->vla-object (entlast)))                                                                                                                                            <br />     ;最后图块为插入的匿名图块          <br />     (vla-put-xscalefactor ref (* (vla-get-xscalefactor ref) sX))                                                                                                                        <br />     ;;将匿名图块变换到可求交点的位置<br />     (vla-put-yscalefactor ref (* (vla-get-yscalefactor ref) sY))<br />     (vla-put-zscalefactor ref (* (vla-get-zscalefactor ref) sZ))<br />           (command "explode" (list (vlax-vla-object->ename ref)  insert_pt) )                                                                                                        <br />           ;将匿名图块炸开以求交点 <br />           (setq new (vlax-ename->vla-object (entlast)) )                                                                                                                                          <br />           ;最后图块为炸开后得到的直线<br />     (vlax-for obj  (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object)) ) <br />                             (cdr(assoc 2 (entget block))) ) <br />                 (cond        (         (member (vla-get-ObjectName obj) Acdblist)<br />                                         (setq intersect_lst (append (vlax-invoke new 'intersectwith obj inter_model) intersect_lst) )                <br />                                         ;调用intersectwith方法求交点<br />                                 )<br />                                 (        (eq (vla-get-ObjectName obj) "AcDbBlockReference" )                                                                                <br />                                         ;递归调用处理块中块<br />                                 (setq intersect_pnt (append (Get-line-block-intersect new obj Acdblist inter_model) intersect_pnt) )<br />                                         ;将递归结果放入 intersect_pnt去再次变换<br />                                 )<br />                 )<br />         )<br />         (vla-delete (vlax-ename->vla-object (entlast)))                                                                                                                                         <br />         ;删除炸开得到的直线<br />         (vla-delete line_blk)                                                                                                                                                                                 <br />         ;删除匿名图块<br />         (if         intersect_lst (setq intersect_pnt (append (Intersect-pnt-Handle intersect_lst) intersect_pnt) ) )                        <br />         ;交点的结果为一维表，将其转化为三维的点列表<br />         (if        intersect_pnt (setq result (mapcar '(lambda(p) (MAT:mxp mat p) ) intersect_pnt) ) )                                <br />         ;将求得的交点变换为实际交点<br />         ;(if         result (NetBee-2dimension-coordinate result (list 0 < >) 0 )        )                                                                        <br />         ;调用排序子程序对交点排序，该子程序在论坛的自定义Lisp函数中有，需要的自己去下载<br /> )

zjupxw

这里有个疑问，highflybird原程序中sclMat定义如下：
(setq sclMat (list (list sX 0 0 1)   ;乘以一个比例缩放矩阵使得比例均匀
               (list 0 sY 0 1)
                     (list 0 0 sZ 1)
                     (list 0 0  0 1)
                )
)
我这样变换出来的直线的Z坐标变为1，使得求不到交点，所以必须将sclMat定义如下：
(setq sclMat (list (list sX 0 0 0)   ;乘以一个比例缩放矩阵使得比例均匀
               (list 0 sY 0 0)
                     (list 0 0 sZ 0)
                     (list 0 0  0 1)
                )
这里不知为什么？

qyming

坐标变换。。。。。。

springwillow

zjupxw 发表于 2013-10-4 16:17
这里有个疑问，highflybird原程序中sclMat定义如下：
(setq sclMat (list (list sX 0 0 1)   ;乘以一个比例 ...

我也不太明白，不过看帮助文件中是这样说的“矩阵的前三列指定缩放比例和旋转角度，第四列是一个转换矢量”。如果第4列都是1会按照下式这样加上去吧，也没弄太明白。

LIULISHENG

看不明白   

guankuiwu

向大佬学习