[分享]：复杂实体求交点的纯LSP函数（起步->拓展）

wkai · 发表于 2003-12-11 16:20:10

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

2003.12.11.15.46:
写程序时经常需要用到求交点的函数，可是Autolisp中只有一个非常简单的直线求交函数INTERS。我在网也看到一些更复杂一点的成品求交函数，大都是用了VLISP的扩展函数，或者是象XD_API这样打包好的ARX函数库。就想写一个纯lsp的通用性更强的复合求交函数。
正好今天不用上班，用了七八个小时写出来了一个可以进行圆,圆弧,线段复合求交点程序。
如果有可能的话，请大侠们出手完善一下，加上椭圆，复义线，SPLINE等，最终能够用autolisp写出可以求出两个任意类型实体的交点的复杂函数。

2003.12.13.09.31(LM):
增加了轻装多义线求交点的函数。

程序如下，请大家测试：

[FONT=courier new]
;______________________________________________________________________
;_圆,圆弧,线段复合求交点程序__纯LSP___BY__WKAI__晓东CAD论坛____________
;_2003.12.13.09.31(LM)_________________________________________________
;_2003.12.11.15.46_____________________________________________________
;______________________________________________________________________
;_测试用程序__在求到的交点处划出一条连到0,0的直线段____________________
;_intersections变量是交点表____________________________________________
(defun c:tt (/ e1 e2 ff intersections n)
(setvar "osmode" 0)
(command "undo" "be")
(princ "\n选择第一个物体:")
(while (not e1) (setq e1 (car (entsel))))
(redraw e1 3)
(princ "\n选择第二个物体:")
(while (not e2) (setq e2 (car (entsel))))
(redraw e2 3)
(setq ff
(getint
"\n第几个物体不延伸(0 都延伸,1 一号不延伸,2 二号不延伸,<3> 全部不延伸):"
)
)
(if (not ff)
(setq ff 3)
)
(getint_of_ents e1 e2 ff);_得到交点表并赋给intersections变量
(foreach n intersections (command "circle" n "500"))
(princ "\n两个物体共有 ")
(princ (length intersections ))
(princ " 个交点")
(redraw e1 4)
(redraw e2 4)
(command "undo" "e")
(princ)
)
;_判断物体类型,选择相应函数求交点_______________________________________
(defun getint_of_ents (en_1 en_2 lim /)
(IF (LISTP EN_1)
()
(SETQ EN_1 (ENTGET EN_1))
)
(IF (LISTP EN_2)
()
(SETQ EN_2 (ENTGET EN_2))
)
(setq e1_tp (cdr (assoc 0 EN_1)))
(setq e2_tp (cdr (assoc 0 EN_2)))
(cond
((= "LWPOLYLINE" e1_tp)
(pi? en_1 en_2 lim)
)
((= "LWPOLYLINE" e2_tp)
(pi? en_2 en_1 (change_order lim))
)
((and (= "CIRCLE" e1_tp) (= "CIRCLE" e2_tp))
(cic en_1 en_2 lim)
)
((and (= "ARC" e1_tp) (= "ARC" e2_tp))
(aia en_1 en_2 lim)
)
((and (= "LINE" e1_tp) (= "LINE" e2_tp))
(lil en_1 en_2 lim)
)
((and (= "CIRCLE" e1_tp) (= "ARC" e2_tp))
(cia en_1 en_2 lim)
)
((and (= "CIRCLE" e1_tp) (= "LINE" e2_tp))
(cil en_1 en_2 lim)
)
((and (= "ARC" e1_tp) (= "LINE" e2_tp))
(ail en_1 en_2 lim)
)
((and (= "ARC" e1_tp) (= "CIRCLE" e2_tp))
(cia en_2 en_1 (change_order lim))
)
((and (= "LINE" e1_tp) (= "CIRCLE" e2_tp))
(cil en_2 en_1 (change_order lim))
)
((and (= "LINE" e1_tp) (= "ARC" e2_tp))
(ail en_2 en_1 (change_order lim))
)
(T (princ "\n请选择圆、圆弧或者线段！"))
)
)
;_反转延长标志_________________________________________________________
(defun change_order (num)
(cond
((= num 1) (setq num 2))
((= num 2) (setq num 1))
)
num
)
;______________________________________________________________________
;______________________________________________________________________
;_________________求交点应用函数部分____BY__WKAI__晓东CAD论坛__________
;___________________2003.12.11.14.33___________________________________
;____limited__决定求交点时物体是否延伸_________________________________
;____0 都延伸,1 一号不延伸,2 二号不延伸,3 全部不延伸___________________
;_圆、圆交点___________________________________________________________
(defun cic (c1 c2 limited / c1_cn c2_cn c1_rd c2_rd ins)
(IF (LISTP C1)
()
(SETQ C1 (ENTGET C1))
)
(IF (LISTP C2)
()
(SETQ C2 (ENTGET C2))
)
(setq c1_cn (cdr (assoc 10 c1)))
(setq c2_cn (cdr (assoc 10 c2)))
(setq c1_rd (cdr (assoc 40 c1)))
(setq c2_rd (cdr (assoc 40 c2)))
(setq ins (c_int_c c1_cn c1_rd c2_cn c2_rd))
(if ins
(setq intersections (append intersections ins))
)
intersections
)
;_圆、圆弧交点_________________________________________________________
(defun cia (c1 c2 limited / ins ins_tmp c1_cn c2_cn c1_rd c2_rd n)
(IF (LISTP C1)
()
(SETQ C1 (ENTGET C1))
)
(IF (LISTP C2)
()
(SETQ C2 (ENTGET C2))
)
(setq c1_cn (cdr (assoc 10 c1)))
(setq c2_cn (cdr (assoc 10 c2)))
(setq c1_rd (cdr (assoc 40 c1)))
(setq c2_rd (cdr (assoc 40 c2)))
(setq c2_an1 (cdr (assoc 50 c2)))
(setq c2_an2 (cdr (assoc 51 c2)))
(setq ins (c_int_c c1_cn c1_rd c2_cn c2_rd))
(if (or (= limited 2) (= limited 3))
(progn
(foreach n ins
(if (p_on_arc n c2_cn c2_an1 c2_an2)
(if ins_tmp
(setq ins_tmp (append ins_tmp (list n)))
(setq ins_tmp (list n))
)
)
)
(setq ins ins_tmp)
)
)
(setq ins ins_tmp)
(if ins
(setq intersections (append intersections ins))
)
intersections
)
;_圆弧、圆弧交点________________________________________________________
(defun aia (c1 c2 limited / ins ins_tmp c1_cn c2_cn c1_rd c2_rd c1_an1 c1_an2 c2_an1 c2_an2 n)
(IF (LISTP C1)
()
(SETQ C1 (ENTGET C1))
)
(IF (LISTP C2)
()
(SETQ C2 (ENTGET C2))
)
(setq c1_cn (cdr (assoc 10 c1)))
(setq c2_cn (cdr (assoc 10 c2)))
(setq c1_rd (cdr (assoc 40 c1)))
(setq c2_rd (cdr (assoc 40 c2)))
(setq c1_an1 (cdr (assoc 50 c1)))
(setq c1_an2 (cdr (assoc 51 c1)))
(setq c2_an1 (cdr (assoc 50 c2)))
(setq c2_an2 (cdr (assoc 51 c2)))
(setq ins (c_int_c c1_cn c1_rd c2_cn c2_rd))
(if (or (= limited 1) (= limited 3))
(progn
(foreach n ins
(if (p_on_arc n c1_cn c1_an1 c1_an2)
(if ins_tmp
(setq ins_tmp (append ins_tmp (list n)))
(setq ins_tmp (list n))
)
)
)
(setq ins ins_tmp)
)
)
(setq ins_tmp nil)
(if (or (= limited 2) (= limited 3))
(progn
(foreach n ins
(if (p_on_arc n c2_cn c2_an1 c2_an2)
(if ins_tmp
(setq ins_tmp (append ins_tmp (list n)))
(setq ins_tmp (list n))
)
)
)
(setq ins ins_tmp)
)
)
(if ins
(setq intersections (append intersections ins))
)
intersections
)
;_圆、直线交点______________________________________________________
(defun cil (c1 l1 limited / end1 end2 cen rad ins ins_tmp n)
(IF (LISTP C1)
()
(SETQ C1 (ENTGET C1))
)
(IF (LISTP L1)
()
(SETQ L1 (ENTGET L1))
)
(setq end1 (cdr (assoc 10 l1)))
(setq end2 (cdr (assoc 11 l1)))
(setq cen (cdr (assoc 10 c1)))
(setq rad (cdr (assoc 40 c1)))
(setq ins (L_INT_C end1 end2 cen rad))
(if (or (= limited 2) (= limited 3))
(progn
(foreach n ins
(if (p_on_line n end1 end2)
(if ins_tmp
(setq ins_tmp (append ins_tmp (list n)))
(setq ins_tmp (list n))
)
)
)
(setq ins ins_tmp)
)
)
(if ins
(setq intersections (append intersections ins))
)
intersections
)
;_圆弧、直线交点______________________________________________________
(defun ail (c1 l1 limited / end1 end2 cen rad ang1 ang2 ins ins_tmp n)
(IF (LISTP C1)
()
(SETQ C1 (ENTGET C1))
)
(IF (LISTP L1)
()
(SETQ L1 (ENTGET L1))
)
(setq end1 (cdr (assoc 10 l1)))
(setq end2 (cdr (assoc 11 l1)))
(setq cen (cdr (assoc 10 c1)))
(setq rad (cdr (assoc 40 c1)))
(setq ang1 (cdr (assoc 50 c1)))
(setq ang2 (cdr (assoc 51 c1)))
(setq ins (L_INT_C end1 end2 cen rad))
(if (or (= limited 1) (= limited 3))
(progn
(foreach n ins
(if (p_on_arc n cen ang1 ang2)
(if ins_tmp
(setq ins_tmp (append ins_tmp (list n)))
(setq ins_tmp (list n))
)
)
)
(setq ins ins_tmp)
)
)
(setq ins_tmp nil)
(if (or (= limited 2) (= limited 3))
(progn
(foreach n ins
(if (p_on_line n end1 end2)
(if ins_tmp
(setq ins_tmp (append ins_tmp (list n)))
(setq ins_tmp (list n))
)
)
)
(setq ins ins_tmp)
)
)
(if ins
(setq intersections (append intersections ins))
)
intersections
)
;_直线、直线交点______________________________________________________
(defun lil (l1 l2 limited / n ins ins_tmp l1_en1 l1_en2 l2_en1 l2_en2)
(if (listp l1)
()
(setq l1 (entget l1))
)
(if (listp l2)
()
(setq l2 (entget l2))
)
(setq l1_en1 (cdr (assoc 10 l1)))
(setq l1_en2 (cdr (assoc 11 l1)))
(setq l2_en1 (cdr (assoc 10 l2)))
(setq l2_en2 (cdr (assoc 11 l2)))
(if (setq ins_tmp (inters l1_en1 l1_en2 l2_en1 l2_en2 nil))
(setq ins (list ins_tmp))
)
(setq ins_tmp nil)
(if (or (= limited 1) (= limited 3))
(progn
(foreach n ins
(if (p_on_line n l1_en1 l1_en2)
(setq ins_tmp (list n))
)
)
(setq ins ins_tmp)
)
)
(setq ins_tmp nil)
(if (or (= limited 2) (= limited 3))
(progn
(foreach n ins
(if (p_on_line n l2_en1 l2_en2)
(setq ins_tmp (list n))
)
)
(setq ins ins_tmp)
)
)
(if ins
(setq intersections (append intersections ins))
)
intersections
)
;_复义线、其它实体交点______________________________________________________
;_如果是两条复义线通过递归求交______________________________________________
(defun pi? (pl1 e2 lim / p1 p2 p3 pts-pl1 n sym1 sym2 ang1 ang2 pl1-sub-ent)
(if (listp pl1)
()
(setq pl1 (entget pl1))
)
(if (listp e2)
()
(setq e2 (entget e2))
)
(setq pts-pl1 (GET_ENDS_PL pl1))
(setq n 1)
(while (< (+ 1 n) (length pts-pl1))
(setq p1 (nth (- n 1) pts-pl1))
(setq p2 (nth n pts-pl1))
(setq p3 (nth (+ n 1) pts-pl1))
(if (listp p2)
(progn
(setq sym1 (car p2))
(setq p2 (cdr p2))
(if (= 1 sym1)
(setq ang1 (angle p2 p1)
ang2 (angle p2 p3)
)
(setq ang1 (angle p2 p3)
ang2 (angle p2 p1)
)
)
(setq pl1-sub-ent
(list (cons 0 "ARC")
(cons 10 p2)
(cons 40 (distance p1 p2))
(cons 50 ang1)
(cons 51 ang2)
(cons 62 1)
)
)
)
(setq pl1-sub-ent
(list (cons 0 "LINE") (cons 10 p1) (cons 11 p3) (cons 62 1))
)
)
(getint_of_ents pl1-sub-ent e2 lim)
(setq n (+ 2 n))
)
)
;______________________________________________________________________
;______________________________________________________________________
;_________________求交点核心函数部分____BY__WKAI__晓东CAD论坛__________
;___________________2003.12.11.14.33___________________________________
;______________________________________________________________________
;_精度设置_____________________________________________________________
(setq min_num 0.0000001)
;___________________圆与圆交点函数,输入值圆心1,半径1,圆心2,半径2.返回值交点表
(defun c_int_c (c1_cen c1_rad c2_cen c2_rad / c1_rad c2_rad ints c1c2_dis dd ee)
(setq c1c2_dis (distance c1_cen c2_cen))
(cond
((equal c1c2_dis (+ c1_rad c2_rad) min_num)
(setq ints (list (polar c1_cen (angle c1_cen c2_cen) c1_rad)))
)
((equal c1c2_dis (abs (- c1_rad c2_rad)) min_num)
(if (minusp (- c1_rad c2_rad))
(setq ints (list (polar c2_cen (angle c2_cen c1_cen) c2_rad)))
(setq ints (list (polar c1_cen (angle c1_cen c2_cen) c1_rad)))
)
)
((and (> c1c2_dis (abs (- c1_rad c2_rad)))
(< c1c2_dis (+ c1_rad c2_rad))
)
(progn
(setq dd (/ (- (+ (* c1c2_dis c1c2_dis) (* c1_rad c1_rad))
(* c2_rad c2_rad)
)
(* 2 c1c2_dis)
)
)
(setq ee (sqrt (- (* c1_rad c1_rad) (* dd dd))))
(setq
ints (list (polar (polar c1_cen (angle c1_cen c2_cen) dd)
(+ (angle c1_cen c2_cen) (/ pi 2))
ee
)
)
)
(setq ints
(append
ints
(list (polar (polar c1_cen (angle c1_cen c2_cen) dd)
(- (angle c1_cen c2_cen) (/ pi 2))
ee
)
)
)
)
)
)
)
ints
)
;___________________直线与圆交点函数,输入值直线端点1,端点2,圆心,半径.返回值交点表
(defun L_INT_C (l_end1 l_end2 c_cen c_rad / pedal dist_cen_l int1 int2 ints)
(setq pedal (pedal_to_line c_cen l_end1 l_end2))
(setq dist_cen_l (distance pedal c_cen))
(cond
((equal c_rad dist_cen_l min_num) (setq ints (list pedal)))
((> c_rad dist_cen_l)
(progn
(setq int1
(polar pedal
(angle l_end1 l_end2)
(sqrt (- (* c_rad c_rad) (* dist_cen_l dist_cen_l)))
)
)
(setq int2
(polar pedal
(+ pi (angle l_end1 l_end2))
(sqrt (- (* c_rad c_rad) (* dist_cen_l dist_cen_l)))
)
)
(setq ints (list int1 int2))
)
)
)
ints
)
;______________________________________________________________________
;______________________________________________________________________
;_________________辅助测试函数部分____BY__WKAI__晓东CAD论坛____________
;___________________2003.12.11.14.33___________________________________
;______________________________________________________________________
;___________________求点到直线的垂足的函数,输入值测试点,直线端点1,端点2.返回值垂足坐标
(defun pedal_to_line (pt pt1 pt2)
(inters
pt
(polar pt (+ (/ pi 2) (angle pt1 pt2)) 1000)
pt1
pt2
nil
)
)
;___________________测试点是否在线段上,输入值测试点,线段端点1,端点2.返回值T或者NIL
(defun p_on_line (pt pt1 pt2)
(equal (+ (distance pt pt1) (distance pt pt2))
(distance pt1 pt2)
min_num
)
)
;___________________测试点是否在圆弧上,输入值测试点,圆心,起始角度,终止角度.返回值T或者NIL
(defun p_on_arc (pt cn an1 an2)
(if (> an1 an2)
(setq an1 (- an1 (* 2 pi))))
(or
(and (>= (+ (angle cn pt) pi pi) an1) (<= (+ (angle cn pt) pi pi) an2))
(and (>= (angle cn pt) an1) (<= (angle cn pt) an2))
(and (>= (- (angle cn pt) pi pi) an1) (<= (- (angle cn pt) pi pi) an2))
)
)
;___________________获取轻装多义线的各个端点和圆心(如果有),输入值复义线实体名或表.返回值端点及圆心表
(DEFUN GET_ENDS_PL (PL / dis dis1 m N PT-LST PT-LST-TMP sym mid-p1p2 NTH-PT p1 p2 pl-tp pt1 rad sym)
(IF (LISTP PL)
()
(SETQ PL (ENTGET PL))
)
(SETQ PL-TP (CDR (ASSOC 70 PL)))
(FOREACH N PL
(IF (OR (= 10 (CAR N)) (= 42 (CAR N)))
(SETQ PT-LST (APPEND PT-LST (LIST (CDR N))))
)
)
(IF (= 1 PL-TP)
(SETQ PT-LST (APPEND PT-LST (LIST (CDR (ASSOC 10 PL)))))
(SETQ PT-LST (reverse (cdr (reverse PT-LST))))
)
(SETQ M 0)
(while (<= (+ 1 m) (LENGTH PT-LST))
(SETQ NTH-PT (NTH M PT-LST))
(IF (LISTP NTH-PT)
(SETQ PT-LST-TMP (APPEND PT-LST-TMP (LIST NTH-PT)))
(PROGN
(IF (EQUAL NTH-PT 0 MIN_NUM)
(SETQ PT-LST-TMP (APPEND PT-LST-TMP (LIST NTH-PT)))
(PROGN
(SETQ P1 (NTH (- M 1) PT-LST))
(SETQ P2 (NTH (+ M 1) PT-LST))
(SETQ MID-P1P2 (LIST (/ (+ (CAR P1) (CAR P2)) 2)
(/ (+ (CADR P1) (CADR P2)) 2)
)
)
(SETQ DIS (/ (DISTANCE P1 P2) 2))
(SETQ DIS1 (ABS (* DIS NTH-PT)))
(SETQ RAD (/ (+ (* DIS DIS) (* DIS1 DIS1)) (* 2 DIS1)))
(IF (minusp NTH-PT)
(SETQ
PT1 (append (list -1)
(POLAR MID-P1P2
(- (ANGLE P1 P2) (/ PI 2))
(- RAD DIS1)
)
)
)
(SETQ
PT1 (append (list 1)
(POLAR MID-P1P2
(+ (ANGLE P1 P2) (/ PI 2))
(- RAD DIS1)
)
)
)
)
(SETQ PT-LST-TMP (APPEND PT-LST-TMP (LIST PT1)))
)
)
)
)
(SETQ M (+ 1 M))
)
(SETQ PT-LST PT-LST-TMP)
)
;_________________________________________________________________________________________
;_________________________________________________________________________________________
;_________________________________________________________________________________________
;_________________________________________________________________________________________
[/FONT]

[FONT=courier new] 
 ;______________________________________________________________________ 
 ;_圆,圆弧,线段复合求交点程序__纯LSP___BY__WKAI__晓东CAD论坛____________ 
 ;_2003.12.13.09.31(LM)_________________________________________________ 
 ;_2003.12.11.15.46_____________________________________________________ 
 ;______________________________________________________________________ 
 
 ;_测试用程序__在求到的交点处划出一条连到0,0的直线段____________________ 
 ;_intersections变量是交点表____________________________________________ 
(defun c:tt  (/ e1 e2 ff intersections n) 
  (setvar "osmode" 0) 
  (command "undo" "be") 
  (princ "\n选择第一个物体:") 
  (while (not e1) (setq e1 (car (entsel)))) 
  (redraw e1 3) 
  (princ "\n选择第二个物体:") 
  (while (not e2) (setq e2 (car (entsel)))) 
  (redraw e2 3) 
  (setq        ff 
         (getint 
           "\n第几个物体不延伸(0 都延伸,1 一号不延伸,2 二号不延伸,<3> 全部不延伸):" 
           ) 
        ) 
  (if (not ff) 
    (setq ff 3) 
    ) 
  (getint_of_ents e1 e2 ff);_得到交点表并赋给intersections变量 
  (foreach n  intersections    (command "circle" n "500"))    
  (princ "\n两个物体共有 ") 
  (princ (length intersections )) 
  (princ " 个交点") 
  (redraw e1 4) 
  (redraw e2 4) 
  (command "undo" "e") 
  (princ) 
  ) 
 ;_判断物体类型,选择相应函数求交点_______________________________________ 
(defun getint_of_ents  (en_1 en_2 lim /) 
  (IF (LISTP EN_1) 
    () 
    (SETQ EN_1 (ENTGET EN_1)) 
    ) 
  (IF (LISTP EN_2) 
    () 
    (SETQ EN_2 (ENTGET EN_2)) 
    ) 
  (setq e1_tp (cdr (assoc 0 EN_1))) 
  (setq e2_tp (cdr (assoc 0 EN_2))) 
  (cond 
    ((= "LWPOLYLINE" e1_tp) 
     (pi? en_1 en_2 lim) 
     ) 
    ((= "LWPOLYLINE" e2_tp) 
     (pi? en_2 en_1 (change_order lim)) 
     ) 
    ((and (= "CIRCLE" e1_tp) (= "CIRCLE" e2_tp)) 
     (cic en_1 en_2 lim) 
     ) 
    ((and (= "ARC" e1_tp) (= "ARC" e2_tp)) 
     (aia en_1 en_2 lim) 
     ) 
    ((and (= "LINE" e1_tp) (= "LINE" e2_tp)) 
     (lil en_1 en_2 lim) 
     ) 
 
    ((and (= "CIRCLE" e1_tp) (= "ARC" e2_tp)) 
     (cia en_1 en_2 lim) 
     ) 
    ((and (= "CIRCLE" e1_tp) (= "LINE" e2_tp)) 
     (cil en_1 en_2 lim) 
     ) 
    ((and (= "ARC" e1_tp) (= "LINE" e2_tp)) 
     (ail en_1 en_2 lim) 
     ) 
 
    ((and (= "ARC" e1_tp) (= "CIRCLE" e2_tp)) 
     (cia en_2 en_1 (change_order lim)) 
     ) 
    ((and (= "LINE" e1_tp) (= "CIRCLE" e2_tp)) 
     (cil en_2 en_1 (change_order lim)) 
     ) 
    ((and (= "LINE" e1_tp) (= "ARC" e2_tp)) 
     (ail en_2 en_1 (change_order lim)) 
     ) 
    (T (princ "\n请选择圆、圆弧或者线段！")) 
    ) 
  ) 
 ;_反转延长标志_________________________________________________________ 
(defun change_order  (num) 
  (cond 
    ((= num 1) (setq num 2)) 
    ((= num 2) (setq num 1)) 
    ) 
  num 
  ) 
 ;______________________________________________________________________ 
 ;______________________________________________________________________ 
 ;_________________求交点应用函数部分____BY__WKAI__晓东CAD论坛__________ 
 ;___________________2003.12.11.14.33___________________________________ 
 ;____limited__决定求交点时物体是否延伸_________________________________ 
 ;____0 都延伸,1 一号不延伸,2 二号不延伸,3 全部不延伸___________________ 
 
 ;_圆、圆交点___________________________________________________________ 
(defun cic  (c1 c2 limited / c1_cn c2_cn c1_rd c2_rd ins) 
  (IF (LISTP C1) 
    () 
    (SETQ C1 (ENTGET C1)) 
    ) 
  (IF (LISTP C2) 
    () 
    (SETQ C2 (ENTGET C2)) 
    ) 
  (setq c1_cn (cdr (assoc 10 c1))) 
  (setq c2_cn (cdr (assoc 10 c2))) 
  (setq c1_rd (cdr (assoc 40 c1))) 
  (setq c2_rd (cdr (assoc 40 c2))) 
  (setq ins (c_int_c c1_cn c1_rd c2_cn c2_rd)) 
  (if ins 
    (setq intersections (append intersections ins)) 
    ) 
  intersections 
  ) 
 ;_圆、圆弧交点_________________________________________________________ 
(defun cia  (c1 c2 limited / ins ins_tmp c1_cn c2_cn c1_rd c2_rd n) 
  (IF (LISTP C1) 
    () 
    (SETQ C1 (ENTGET C1)) 
    ) 
  (IF (LISTP C2) 
    () 
    (SETQ C2 (ENTGET C2)) 
    ) 
  (setq c1_cn (cdr (assoc 10 c1))) 
  (setq c2_cn (cdr (assoc 10 c2))) 
  (setq c1_rd (cdr (assoc 40 c1))) 
  (setq c2_rd (cdr (assoc 40 c2))) 
  (setq c2_an1 (cdr (assoc 50 c2))) 
  (setq c2_an2 (cdr (assoc 51 c2))) 
  (setq ins (c_int_c c1_cn c1_rd c2_cn c2_rd)) 
  (if (or (= limited 2) (= limited 3)) 
    (progn 
      (foreach n  ins 
        (if (p_on_arc n c2_cn c2_an1 c2_an2) 
          (if ins_tmp 
            (setq ins_tmp (append ins_tmp (list n))) 
            (setq ins_tmp (list n)) 
            ) 
          ) 
        ) 
      (setq ins ins_tmp) 
      ) 
    ) 
  (setq ins ins_tmp) 
  (if ins 
    (setq intersections (append intersections ins)) 
    ) 
  intersections 
  ) 
 ;_圆弧、圆弧交点________________________________________________________ 
(defun aia  (c1        c2 limited / ins ins_tmp c1_cn c2_cn c1_rd c2_rd c1_an1        c1_an2 c2_an1 c2_an2 n) 
  (IF (LISTP C1) 
    () 
    (SETQ C1 (ENTGET C1)) 
    ) 
  (IF (LISTP C2) 
    () 
    (SETQ C2 (ENTGET C2)) 
    ) 
  (setq c1_cn (cdr (assoc 10 c1))) 
  (setq c2_cn (cdr (assoc 10 c2))) 
  (setq c1_rd (cdr (assoc 40 c1))) 
  (setq c2_rd (cdr (assoc 40 c2))) 
  (setq c1_an1 (cdr (assoc 50 c1))) 
  (setq c1_an2 (cdr (assoc 51 c1))) 
  (setq c2_an1 (cdr (assoc 50 c2))) 
  (setq c2_an2 (cdr (assoc 51 c2))) 
  (setq ins (c_int_c c1_cn c1_rd c2_cn c2_rd)) 
  (if (or (= limited 1) (= limited 3)) 
    (progn 
      (foreach n  ins 
        (if (p_on_arc n c1_cn c1_an1 c1_an2) 
          (if ins_tmp 
            (setq ins_tmp (append ins_tmp (list n))) 
            (setq ins_tmp (list n)) 
            ) 
          ) 
        ) 
      (setq ins ins_tmp) 
      ) 
    ) 
  (setq ins_tmp nil) 
  (if (or (= limited 2) (= limited 3)) 
    (progn 
      (foreach n  ins 
        (if (p_on_arc n c2_cn c2_an1 c2_an2) 
          (if ins_tmp 
            (setq ins_tmp (append ins_tmp (list n))) 
            (setq ins_tmp (list n)) 
            ) 
          ) 
        ) 
      (setq ins ins_tmp) 
      ) 
    ) 
  (if ins 
    (setq intersections (append intersections ins)) 
    ) 
  intersections 
  ) 
 ;_圆、直线交点______________________________________________________ 
(defun cil  (c1 l1 limited / end1 end2 cen rad ins ins_tmp n) 
  (IF (LISTP C1) 
    () 
    (SETQ C1 (ENTGET C1)) 
    ) 
  (IF (LISTP L1) 
    () 
    (SETQ L1 (ENTGET L1)) 
    ) 
  (setq end1 (cdr (assoc 10 l1))) 
  (setq end2 (cdr (assoc 11 l1))) 
  (setq cen (cdr (assoc 10 c1))) 
  (setq rad (cdr (assoc 40 c1))) 
  (setq ins (L_INT_C end1 end2 cen rad)) 
  (if (or (= limited 2) (= limited 3)) 
    (progn 
      (foreach n  ins 
        (if (p_on_line n end1 end2) 
          (if ins_tmp 
            (setq ins_tmp (append ins_tmp (list n))) 
            (setq ins_tmp (list n)) 
            ) 
          ) 
        ) 
      (setq ins ins_tmp) 
      ) 
    ) 
  (if ins 
    (setq intersections (append intersections ins)) 
    ) 
  intersections 
  ) 
 ;_圆弧、直线交点______________________________________________________ 
(defun ail  (c1 l1 limited / end1 end2 cen rad ang1 ang2 ins ins_tmp n) 
  (IF (LISTP C1) 
    () 
    (SETQ C1 (ENTGET C1)) 
    ) 
  (IF (LISTP L1) 
    () 
    (SETQ L1 (ENTGET L1)) 
    ) 
  (setq end1 (cdr (assoc 10 l1))) 
  (setq end2 (cdr (assoc 11 l1))) 
  (setq cen (cdr (assoc 10 c1))) 
  (setq rad (cdr (assoc 40 c1))) 
  (setq ang1 (cdr (assoc 50 c1))) 
  (setq ang2 (cdr (assoc 51 c1))) 
  (setq ins (L_INT_C end1 end2 cen rad)) 
  (if (or (= limited 1) (= limited 3)) 
    (progn 
      (foreach n  ins 
        (if (p_on_arc n cen ang1 ang2) 
          (if ins_tmp 
            (setq ins_tmp (append ins_tmp (list n))) 
            (setq ins_tmp (list n)) 
            ) 
          ) 
        ) 
      (setq ins ins_tmp) 
      ) 
    ) 
  (setq ins_tmp nil) 
  (if (or (= limited 2) (= limited 3)) 
    (progn 
      (foreach n  ins 
        (if (p_on_line n end1 end2) 
          (if ins_tmp 
            (setq ins_tmp (append ins_tmp (list n))) 
            (setq ins_tmp (list n)) 
            ) 
          ) 
        ) 
      (setq ins ins_tmp) 
      ) 
    ) 
  (if ins 
    (setq intersections (append intersections ins)) 
    ) 
  intersections 
  ) 
 ;_直线、直线交点______________________________________________________ 
(defun lil  (l1 l2 limited / n ins ins_tmp l1_en1 l1_en2 l2_en1 l2_en2) 
  (if (listp l1) 
    () 
    (setq l1 (entget l1)) 
    ) 
  (if (listp l2) 
    () 
    (setq l2 (entget l2)) 
    ) 
  (setq l1_en1 (cdr (assoc 10 l1))) 
  (setq l1_en2 (cdr (assoc 11 l1))) 
  (setq l2_en1 (cdr (assoc 10 l2))) 
  (setq l2_en2 (cdr (assoc 11 l2))) 
  (if (setq ins_tmp (inters l1_en1 l1_en2 l2_en1 l2_en2 nil)) 
    (setq ins (list ins_tmp)) 
    ) 
  (setq ins_tmp nil) 
  (if (or (= limited 1) (= limited 3)) 
    (progn 
      (foreach n  ins 
        (if (p_on_line n l1_en1 l1_en2) 
          (setq ins_tmp (list n)) 
          ) 
        ) 
      (setq ins ins_tmp) 
      ) 
    ) 
  (setq ins_tmp nil) 
  (if (or (= limited 2) (= limited 3)) 
    (progn 
      (foreach n  ins 
        (if (p_on_line n l2_en1 l2_en2) 
          (setq ins_tmp (list n)) 
          ) 
        ) 
      (setq ins ins_tmp) 
      ) 
    ) 
  (if ins 
    (setq intersections (append intersections ins)) 
    ) 
  intersections 
  ) 
 ;_复义线、其它实体交点______________________________________________________ 
 ;_如果是两条复义线通过递归求交______________________________________________ 
(defun pi?  (pl1 e2 lim / p1 p2 p3 pts-pl1 n sym1 sym2 ang1 ang2 pl1-sub-ent) 
  (if (listp pl1) 
    () 
    (setq pl1 (entget pl1)) 
    ) 
  (if (listp e2) 
    () 
    (setq e2 (entget e2)) 
    ) 
  (setq pts-pl1 (GET_ENDS_PL pl1)) 
  (setq n 1) 
  (while (< (+ 1 n) (length pts-pl1)) 
    (setq p1 (nth (- n 1) pts-pl1)) 
    (setq p2 (nth n pts-pl1)) 
    (setq p3 (nth (+ n 1) pts-pl1)) 
    (if        (listp p2) 
      (progn 
        (setq sym1 (car p2)) 
        (setq p2 (cdr p2)) 
        (if (= 1 sym1) 
          (setq        ang1 (angle p2 p1) 
                ang2 (angle p2 p3) 
                ) 
          (setq        ang1 (angle p2 p3) 
                ang2 (angle p2 p1) 
                ) 
          ) 
        (setq pl1-sub-ent 
               (list (cons 0 "ARC") 
                     (cons 10 p2) 
                     (cons 40 (distance p1 p2)) 
                     (cons 50 ang1) 
                     (cons 51 ang2) 
                     (cons 62 1) 
                     ) 
              ) 
        ) 
      (setq pl1-sub-ent 
             (list (cons 0 "LINE") (cons 10 p1) (cons 11 p3) (cons 62 1)) 
            ) 
      ) 
    (getint_of_ents pl1-sub-ent e2 lim) 
    (setq n (+ 2 n)) 
    ) 
  ) 
 ;______________________________________________________________________ 
 ;______________________________________________________________________ 
 ;_________________求交点核心函数部分____BY__WKAI__晓东CAD论坛__________ 
 ;___________________2003.12.11.14.33___________________________________ 
 ;______________________________________________________________________ 
 ;_精度设置_____________________________________________________________ 
(setq min_num 0.0000001) 
 ;___________________圆与圆交点函数,输入值圆心1,半径1,圆心2,半径2.返回值交点表 
(defun c_int_c        (c1_cen c1_rad c2_cen c2_rad / c1_rad c2_rad ints c1c2_dis dd ee) 
  (setq c1c2_dis (distance c1_cen c2_cen)) 
  (cond 
    ((equal c1c2_dis (+ c1_rad c2_rad) min_num) 
     (setq ints (list (polar c1_cen (angle c1_cen c2_cen) c1_rad))) 
     ) 
    ((equal c1c2_dis (abs (- c1_rad c2_rad)) min_num) 
     (if (minusp (- c1_rad c2_rad)) 
       (setq ints (list (polar c2_cen (angle c2_cen c1_cen) c2_rad))) 
       (setq ints (list (polar c1_cen (angle c1_cen c2_cen) c1_rad))) 
       ) 
     ) 
    ((and (> c1c2_dis (abs (- c1_rad c2_rad))) 
          (< c1c2_dis (+ c1_rad c2_rad)) 
          ) 
     (progn 
       (setq dd        (/ (- (+ (* c1c2_dis c1c2_dis) (* c1_rad c1_rad)) 
                      (* c2_rad c2_rad) 
                      ) 
                   (* 2 c1c2_dis) 
                   ) 
             ) 
       (setq ee (sqrt (- (* c1_rad c1_rad) (* dd dd)))) 
       (setq 
         ints (list (polar (polar c1_cen (angle c1_cen c2_cen) dd) 
                           (+ (angle c1_cen c2_cen) (/ pi 2)) 
                           ee 
                           ) 
                    ) 
         ) 
       (setq ints 
              (append 
                ints 
                (list (polar (polar c1_cen (angle c1_cen c2_cen) dd) 
                             (- (angle c1_cen c2_cen) (/ pi 2)) 
                             ee 
                             ) 
                      ) 
                ) 
             ) 
 
       ) 
     ) 
    ) 
  ints 
  ) 
 ;___________________直线与圆交点函数,输入值直线端点1,端点2,圆心,半径.返回值交点表 
(defun L_INT_C        (l_end1 l_end2 c_cen c_rad / pedal dist_cen_l int1 int2 ints) 
  (setq pedal (pedal_to_line c_cen l_end1 l_end2)) 
  (setq dist_cen_l (distance pedal c_cen)) 
  (cond 
    ((equal c_rad dist_cen_l min_num) (setq ints (list pedal))) 
    ((> c_rad dist_cen_l) 
     (progn 
       (setq int1 
              (polar pedal 
                     (angle l_end1 l_end2) 
                     (sqrt (- (* c_rad c_rad) (* dist_cen_l dist_cen_l))) 
                     ) 
             ) 
       (setq int2 
              (polar pedal 
                     (+ pi (angle l_end1 l_end2)) 
                     (sqrt (- (* c_rad c_rad) (* dist_cen_l dist_cen_l))) 
                     ) 
             ) 
       (setq ints (list int1 int2)) 
       ) 
     ) 
    ) 
  ints 
  ) 
 ;______________________________________________________________________ 
 ;______________________________________________________________________ 
 ;_________________辅助测试函数部分____BY__WKAI__晓东CAD论坛____________ 
 ;___________________2003.12.11.14.33___________________________________ 
 ;______________________________________________________________________ 
 ;___________________求点到直线的垂足的函数,输入值测试点,直线端点1,端点2.返回值垂足坐标 
(defun pedal_to_line  (pt pt1 pt2) 
  (inters 
    pt 
    (polar pt (+ (/ pi 2) (angle pt1 pt2)) 1000) 
    pt1 
    pt2 
    nil 
    ) 
  ) 
 ;___________________测试点是否在线段上,输入值测试点,线段端点1,端点2.返回值T或者NIL 
(defun p_on_line  (pt pt1 pt2) 
  (equal (+ (distance pt pt1) (distance pt pt2)) 
         (distance pt1 pt2) 
         min_num 
         ) 
  ) 
 ;___________________测试点是否在圆弧上,输入值测试点,圆心,起始角度,终止角度.返回值T或者NIL 
(defun p_on_arc         (pt cn an1 an2) 
  (if (> an1 an2) 
    (setq an1 (- an1 (* 2 pi)))) 
  (or 
    (and (>= (+ (angle cn pt) pi pi) an1) (<= (+ (angle cn pt) pi pi) an2)) 
    (and (>= (angle cn pt) an1) (<= (angle cn pt) an2)) 
    (and (>= (- (angle cn pt) pi pi) an1) (<= (- (angle cn pt) pi pi) an2)) 
    ) 
  ) 
 ;___________________获取轻装多义线的各个端点和圆心(如果有),输入值复义线实体名或表.返回值端点及圆心表 
(DEFUN GET_ENDS_PL  (PL        / dis dis1 m N PT-LST PT-LST-TMP sym mid-p1p2 NTH-PT p1        p2 pl-tp pt1 rad sym) 
  (IF (LISTP PL) 
    () 
    (SETQ PL (ENTGET PL)) 
    ) 
  (SETQ PL-TP (CDR (ASSOC 70 PL))) 
  (FOREACH N  PL 
    (IF        (OR (= 10 (CAR N)) (= 42 (CAR N))) 
      (SETQ PT-LST (APPEND PT-LST (LIST (CDR N)))) 
      ) 
    ) 
  (IF (= 1 PL-TP) 
    (SETQ PT-LST (APPEND PT-LST (LIST (CDR (ASSOC 10 PL))))) 
    (SETQ PT-LST (reverse (cdr (reverse PT-LST)))) 
    ) 
  (SETQ M 0) 
  (while (<= (+ 1 m) (LENGTH PT-LST)) 
    (SETQ NTH-PT (NTH M PT-LST)) 
    (IF        (LISTP NTH-PT) 
      (SETQ PT-LST-TMP (APPEND PT-LST-TMP (LIST NTH-PT))) 
      (PROGN 
        (IF (EQUAL NTH-PT 0 MIN_NUM) 
          (SETQ PT-LST-TMP (APPEND PT-LST-TMP (LIST NTH-PT))) 
          (PROGN 
            (SETQ P1 (NTH (- M 1) PT-LST)) 
            (SETQ P2 (NTH (+ M 1) PT-LST)) 
            (SETQ MID-P1P2 (LIST (/ (+ (CAR P1) (CAR P2)) 2) 
                                 (/ (+ (CADR P1) (CADR P2)) 2) 
                                 ) 
                  ) 
            (SETQ DIS (/ (DISTANCE P1 P2) 2)) 
            (SETQ DIS1 (ABS (* DIS NTH-PT))) 
            (SETQ RAD (/ (+ (* DIS DIS) (* DIS1 DIS1)) (* 2 DIS1))) 
            (IF        (minusp NTH-PT) 
              (SETQ 
                PT1 (append (list -1) 
                            (POLAR MID-P1P2 
                                   (- (ANGLE P1 P2) (/ PI 2)) 
                                   (- RAD DIS1) 
                                   ) 
                            ) 
                ) 
              (SETQ 
                PT1 (append (list 1) 
                            (POLAR MID-P1P2 
                                   (+ (ANGLE P1 P2) (/ PI 2)) 
                                   (- RAD DIS1) 
                                   ) 
                            ) 
                ) 
              ) 
            (SETQ PT-LST-TMP (APPEND PT-LST-TMP (LIST PT1))) 
            ) 
          ) 
        ) 
      ) 
    (SETQ M (+ 1 M)) 
    ) 
  (SETQ PT-LST PT-LST-TMP) 
  ) 
 ;_________________________________________________________________________________________ 
 ;_________________________________________________________________________________________ 
 ;_________________________________________________________________________________________ 
 ;_________________________________________________________________________________________ 
 
  [/FONT]

这是我两[/COLOR] 天的心血，请大家指正。
如有引用请注明出处。

LUCAS · 发表于 2003-12-11 16:50:33

參考看看
http://www.xdcad.net/forum/showt ... ghlight=Bill+Kramer

aeo · 发表于 2003-12-11 20:32:35

最初由 LUCAS 发布
[B]參考看看
http://www.xdcad.net/forum/showt ... ghlight=Bill+Kramer [/B]

现在还在用r14是件痛苦的事情:(
还有什么办法？

wkai · 发表于 2003-12-13 10:03:15

感谢 aeo 斑竹的支持。今天又增加lwpl求交功能.

lsjjm · 发表于 2003-12-13 10:44:45

VLISP不是纯LISP吗?
我同意AEO的观点, 如果条件有限, 只是一般用用R14也就算了. 如果放着新的不用, 再对R14花大力气, 得不偿失

陌生人 · 发表于 2004-5-7 17:38:44

真是长篇巨著，兄弟佩服！
用ｖｌ写很简单的：）支持所有曲线类型

lzy9788 · 发表于 2004-8-10 16:41:18

返回有交点列表吗？
可以实现通过在屏幕上点取两点来求出与所有线的交点吗，得到一列表

topyjs · 发表于 2009-7-4 16:03:31

学习了

hbbboss · 发表于 2009-7-8 22:39:01

现在还在用r14是件痛苦的事情

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

[分享]：复杂实体求交点的纯LSP函数（起步->拓展）

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子