坐标变换法求块参照与曲线的交点， 向highflybird学习致敬!
本帖最后由 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 去下载！(defunGet-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) ) ) ;交点的结果为一维表，将其转化为三维的点列表
(ifintersect_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编辑器中，看着效果还可以的! ^_^ 很好的程序，学习了。 忘记后面跟着的一段子程序了，Sorry！;;本子程序用于处理一维交点程序点至三维交点
(defun Intersect-pnt-Handle ( intersect_pnt_lst / result_pnt_lst )
(ifintersect_pnt_lst
(progn
(repeat (/ (lengthintersect_pnt_lst) 3)
(setq result_pnt_lst (cons (list (carintersect_pnt_lst) (cadrintersect_pnt_lst) (caddrintersect_pnt_lst)) result_pnt_lst)
intersect_pnt_lst (cdddr intersect_pnt_lst)
)
)
)
)
(reverse result_pnt_lst)
) 手机上看不到你的程序，先猜想一下你是怎么做的。1 首先将曲线变换到块ECS中， 2块内各线与曲线求交点， 3 交点变换到WCS下 本帖最后由 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 00 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函数中有，需要的自己去下载
) 这里有个疑问，highflybird原程序中sclMat定义如下：
(setq sclMat (list (list sX 0 0 1) ;乘以一个比例缩放矩阵使得比例均匀
(list 0 sY 0 1)
(list 0 0 sZ 1)
(list 0 00 1)
)
)
我这样变换出来的直线的Z坐标变为1，使得求不到交点，所以必须将sclMat定义如下：
(setq sclMat (list (list sX 0 0 0) ;乘以一个比例缩放矩阵使得比例均匀
(list 0 sY 0 0)
(list 0 0 sZ 0)
(list 0 00 1)
)
这里不知为什么？
坐标变换。。。。。。 zjupxw 发表于 2013-10-4 16:17 static/image/common/back.gif
这里有个疑问，highflybird原程序中sclMat定义如下：
(setq sclMat (list (list sX 0 0 1) ;乘以一个比例 ...
我也不太明白，不过看帮助文件中是这样说的“矩阵的前三列指定缩放比例和旋转角度，第四列是一个转换矢量”。如果第4列都是1会按照下式这样加上去吧，也没弄太明白。 看不明白 向大佬学习
页:
[1]