[求助]请问如何求出两条多义线的交点？
Trim->读出新点-〉回退。回复
用下面的代码试试:;;
;; Get all nodes of the LWPolyline, Polyline.
;;
(defun GetListOfPline (EntityName / SSE_Pline N newEntityName)
(setq SSE_Pline (entget EntityName))
(setq LastList nil)
(if (= (cdr (assoc 0 SSE_Pline)) "LWPOLYLINE")
(progn
(setq LastList (LIST (LIST 0 0)))
(setq N 0)
(while (/= (nth N SSE_Pline) nil)
(if (= (car (nth N SSE_Pline)) 10)
(setq LastList (append LastList (list (list (cadr (nth N SSE_Pline)) (caddr (nth N SSE_Pline)) )) ))
)
(setq N (+ N 1))
)
(setq LastList (cdr LastList))
)
)
(if (= (cdr (ASSOC 0 SSE_Pline)) "POLYLINE")
(PROGN
(setq LastList (list (list 0 0)))
(setq newEntityName (entnext EntityName))
(while (= (cdr (assoc 0 (entget newEntityName))) "VERTEX")
(setq LastList (append LastList (list (list (cadr (assoc 10 (entget newEntityName))) (caddr (assoc 10 (entget newEntityName))) ))))
(setq newEntityName (entnext newEntityName))
)
(setq LastList (cdr LastList))
)
)
(setq LastList LastList)
);_defun
;;
;; main function
;;
(defun c:getInsPtOfPl ( / ent_name1 pt_list1 ent_name2 pt_list2 i j pta0 pta1 ins_pt pt_ins_list)
(setq ent_name1 (car (entsel "\nSelect first entity:")))
(setq pt_list1 (GetListOfPline ent_name1))
(setq ent_name2 (car (entsel "\nSecond entity:")))
(setq pt_list2 (GetListOfPline ent_name2))
(setq i 1 j 1)
(setq pta0 (nth 0 pt_list1))
(while (setq pta1 (nth i pt_list1))
(setq ptb0 (nth 0 pt_list2))
(while (setq ptb1 (nth j pt_list2))
(if (and (setq ins_pt (inters pta0 pta1 ptb0 ptb1 t))
(not (member ins_pt pt_ins_list))
)
(progn
(setq pt_ins_list (append pt_ins_list (list ins_pt)))
)
);_if
(setq ptb0 ptb1)
(setq j (+ j 1))
);_while
(setq j 1)
(setq pta0 pta1)
(setq i (+ i 1))
);_while
pt_ins_list
);_defun
没有错误处理,不过应该可以说明一定问题了,主函数中pt_ins_list变量返回两条多义线的交点表. 提供一个用ax的方法，对所有曲线均有效
(defun c:GIP ()
(c:getinterpoint)
)
(defun C:GetInterPoint (/ ent1 ent2 ent_1 ent_2
ax_ent_1 ax_ent_2 intpoints i
j k disp
)
(setq ent1 (entsel "\n选择第一条曲线:"))
(setq ent2 (entsel "\n选择第二条曲线:"))
(setq ent_1 (car ent1)
ent_2 (car ent2)
)
(setq ax_ent_1 (vlax-ename->vla-object ent_1)
ax_ent_2 (vlax-ename->vla-object ent_2)
)
(setq intpoints (vla-intersectwith ax_ent_1 ax_ent_2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
(progn
(setq i 0)
(setq j 0)
(setq k 0)
(setq disp "")
(repeat
(/ (+ 1
(- (vlax-safearray-get-u-bound intpoints 1)
(vlax-safearray-get-l-bound intpoints 1)
)
)
3
)
(setq
disp (strcat
disp
"\n交点"
(itoa (+ k 1))
"坐标为:"
(rtos (vlax-safearray-get-element intpoints j))
" , "
(rtos (vlax-safearray-get-element intpoints (+ 1 j)))
" , "
(rtos (vlax-safearray-get-element intpoints (+ 2 j)))
)
)
(setq i (+ 2 i)
j (+ 3 j)
k (+ 1 k)
)
)
(princ disp)
)
(princ "\n两曲线没有交点")
)
(princ "\n明经通道LISP示例-求两曲线交点")
(princ)
) (defun c:test ()
(vl-load-com)
(setq a (car (entsel "\nSelect First Object: ")))
(setq b (car (entsel "\nSelect Second Object: ")))
(setq pts (vla-IntersectWith
(vlax-ename->vla-object a)
(vlax-ename->vla-object b)
acExtendnone
))
(setq ins (not (minusp (vlax-safearray-get-u-bound (vlax-variant-value pts) 1))))
(cond
((ins
(setq plist (vlax-safearray->list (vlax-variant-value pts)))
(repeat (/ (length plist) 3)
(setq pl (cons (list (car plist)(cadr plist)(caddr plist)) pl)
plist (cdddr plist))
);r
))
);c
ins
);
pl-insection point mccad 的代码很完善了
谢谢各位
谢谢 mccad，你的程序要经ＶＬ编译后才能用，还有就是如两条曲线是空间相交（标高不同，但有视觉交点）就求不出交点了你好，为什么不编译就会出现函数定义错误？ 只要加载(vl-load-com)
再加载程序就可以了，不需要编译