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

zjupxw · 发表于 2013-10-3 17:27:22

本帖最后由 zjupxw 于 2013-10-3 22:35 编辑

国庆就要过去三天了，这三天一直在学习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 去下载！

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

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

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

vlisp2012 · 发表于 2013-10-3 21:28:58

很好的程序，学习了。

zjupxw · 发表于 2013-10-3 22:34:05

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

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

自贡黄明儒 · 发表于 2013-10-4 11:36:06

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

zjupxw · 发表于 2013-10-4 16:10:26

本帖最后由 zjupxw 于 2013-10-4 16:12 编辑

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

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

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

zjupxw · 发表于 2013-10-4 16:17:00

这里有个疑问，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 · 发表于 2014-7-6 15:49:17

坐标变换。。。。。。

springwillow · 发表于 2014-7-8 17:06:52

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

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

LIULISHENG · 发表于 2020-3-7 11:12:36

看不明白

guankuiwu · 发表于 2022-10-10 21:08:03

向大佬学习

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

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

相关帖子

本帖子中包含更多资源

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

相关帖子

本帖子中包含更多资源

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