[求助]请问如何求出两条多义线的交点？

陈伯雄 · 发表于 2003-7-21 11:10:00

Trim->读出新点-〉回退。

王咣生 · 发表于 2003-7-21 14:27:00

用下面的代码试试:

;;
;; 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

;; 
;; 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变量返回两条多义线的交点表.

mccad · 发表于 2003-7-21 20:07:00

提供一个用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: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) 
)

shicai · 发表于 2003-7-22 04:57:00

(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

daziran · 发表于 2003-7-24 14:07:00

mccad 的代码很完善了

lusj · 发表于 2003-7-24 21:58:00

lusj · 发表于 2003-7-28 10:47:00

谢谢 mccad，你的程序要经ＶＬ编译后才能用，还有就是如两条曲线是空间相交（标高不同，但有视觉交点）就求不出交点了

lusj · 发表于 2003-7-28 10:53:00

你好，为什么不编译就会出现函数定义错误？

meflying · 发表于 2003-7-28 11:00:00

只要加载(vl-load-com)
再加载程序就可以了，不需要编译

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

[求助]请问如何求出两条多义线的交点？

回复

本帖子中包含更多资源

评分

谢谢各位

浏览过的版块