贴一个求交点的代码？希望高手指正！
以前用inters函数求交点，但遇到多义线包括圆弧段时不准确，最近看了一下帖子，采用trim命令求交点，可以求虚交点，比较准确，但时速度上比较慢！大家探讨探讨吧！(defun test2 (/ m_pqx m_ent m_enttmp m_vlaobj m_vlaobj1 m_entlen<BR> m_startpt m_endpt m_wlbpt m_wrupt m_ss m_ss1<BR> i n m_endpt1 m_jdtab m_flag m_kz<BR> )<BR> (setq m_pqx (car (entsel "\n请选择一条剖切线:")))<BR> (setq m_vlaobj (vlax-ename->vla-object m_pqx))<BR> (vla-getboundingbox m_vlaobj 'm_wlbpt 'm_wrupt)<BR> (setq m_wlbpt (vlax-safearray->list m_wlbpt))<BR> (setq m_wrupt (vlax-safearray->list m_wrupt))<BR> (print m_wlbpt)(print m_wrupt)<BR> (command "zoom" "w" m_wlbpt m_wrupt);;缩放以使剖切线充满屏幕<BR> ;;窗口右下角点<BR> (setq m_ss (ssget "c" m_wlbpt m_wrupt '((-4 . "<or") (0 . "line") (0 . "polyline") (0 . "lwpolyline")<BR> (0 . "arc") (0 . "circle") (0 . "spline") (0 . "ellipse")(0 . "3dpoly")<BR> (-4 . "or>")<BR> )<BR> )<BR> ) ;;窗口交选<BR> <BR> (setq m_ss (ssdel m_pqx m_ss));;删除剖切线本身
(command "copy" m_pqx "" <A href='mailto:"0,0" target="_blank" >"0,0" "@0,0</A>");;复制以便下面剪切操作(即被修剪线) <BR> (setq m_enttmp (entlast));;取得被修剪线实体名<BR> (setq m_vlaobj (vlax-ename->vla-object m_enttmp))<BR> (setq m_startpt (vlax-curve-getstartpoint m_vlaobj));;取得被修建线的开始点<BR> <BR> (setq m_kz 0.001)<BR> (setq m_jdtab '())<BR> (setq i 0)<BR> (repeat (sslength m_ss)<BR> (setq m_ent (ssname m_ss i));;取出选择集中的一个实体作为修剪边界线<BR> (setq m_endpt (vlax-curve-getendpoint m_vlaobj));;取得被修剪线的最后一个点坐标<BR> (setq m_entlen (vlax-curve-getdistatpoint m_vlaobj m_endpt));;被修剪线长度<BR> (setq m_endpt1 (vlax-curve-getpointatdist m_vlaobj (- m_entlen m_kz)));;取得被修剪线上距最后一点m_kz长度的点,m_kz可调
(setq m_flag t n 0)<BR> (while m_flag<BR> (command "trim" m_ent "" (list m_enttmp m_endpt1) "");;修剪复制线<BR> (command "select" m_startpt "");;单选目标<BR> (setq m_ss1 (ssget "p"));;选取被修剪线修建后的实体,虽是两线重合，但select命令只选择最近操作过的实体<BR> (setq n (+ 2 n));;存储被修剪了多少次+'select的次数，供后面恢复用<BR> (setq m_enttmp (ssname m_ss1 0));;被选择的实体名<BR> (setq m_vlaobj1 (vlax-ename->vla-object m_enttmp))<BR> (setq m_ss1 nil);;清除选择集<BR> (setq m_endpt1 (vlax-curve-getendpoint m_vlaobj1));;被修剪线修剪后的最后一个点坐标<BR> (if (> (distance m_endpt m_endpt1) 0.000000001);;如果两点重合，则认为已无交点<BR> (progn<BR> (setq m_entlen (vlax-curve-getdistatpoint m_vlaobj m_endpt1));;被修剪线修剪后的长度<BR> (setq m_jdtab (cons (list m_entlen (list m_ent m_endpt1)) m_jdtab));;储存交点标数据（距起点距离（修剪边界实体名 交点坐标））<BR> (setq m_endpt m_endpt1);;<BR> (setq m_endpt1 (vlax-curve-getpointatdist m_vlaobj (- m_entlen m_kz)))<BR> )<BR> (setq m_flag nil)<BR> )<BR> )<BR> (command "undo" n);;放弃修剪，恢复被修剪线m_enttmp实体<BR> (setq n 0)<BR> (setq i (1+ i))<BR> )<BR> (command "undo" 1)<BR> (setq m_jdtab (vl-sort m_jdtab '(lambda (a b) (< (car a)(car b)))));;按距离由小到大排序<BR> (print m_jdtab);;打印<BR> (princ)<BR>)
这是本人在编绘制地形剖面线程序中的一段代码，也是核心部分！需要注意的是剖切线不能是3维多段线，即剖切线各节点高程应该相同才行！ 采用intersectwith函数求交点倒是比较方便，但只适用于相交两线共面的情况，谁知道在Vlisp程序中怎样使两线共面？ 只有将两个图元复制后设置为Z=0,求交点，再删除
页:
[1]