;;;get inters from [point line arc pline circle]
(defun c:j (/ osm) (setvar "cmdecho" 0) (setq osm (getvar "osmode")) (setvar "osmode" 0)
(defun getinter (s1 s2 / name dxf_nub long1 long2 long3 x lst lst1 lst2 lst3 lst4 lst5 lst6 lst7 lst8 pt )
;;;获取图元组码 (defun getdxf (name dxf_nub /) (cdr (assoc dxf_nub (entget name))) )
;;;海伦公式,知道三边长求面积再求某高 ;传进三边长,传出第一边的高 (defun geth (long1 long2 long3 / s) (setq s (/ (+ long1 long2 long3) 2.)) (setq dis_l2c (* 2. (/ (sqrt (* s (- s long1) (- s long2) (- s long3))) long1 ) ) ) ) ;;;返回表过滤,去除重复和空的表素 ;传进表x,传出表lst (defun filters (x / len i j a b notin) (setq len (length x)) (setq lst (list '())) (setq i 0) (setq notin nil) (if (> len 1) (progn (repeat len (setq a (nth i x)) (if a (progn (setq j i) (setq notin nil) (repeat (- len j 1) (setq b (nth (1+ j) x)) (if (and b (= (rtos (car a) 2 4) (rtos (car b) 2 4)) (= (rtos (cadr a) 2 4) (rtos (cadr b) 2 4)) (= (rtos (last a) 2 4) (rtos (last b) 2 4)) ) (setq notin t) ) (setq j (1+ j)) ) (if (not notin) (setq lst (cons a lst)) ) ) ) (setq i (1+ i)) ) (setq lst (cdr (reverse lst))) ) (car x) ) )
;;;点和点重合的断 ; (defun POINT2POINT (x /) ;(print "p2p") (if (= 0 (distance (getdxf s1 10) (getdxf s2 10) ) ) (getdxf s1 10) nil ) )
;;;点和线的判断,点到两端点长度等于线长 (defun POINT2LINE (x / pt pt1 pt2 s3) ;(print "pt2l") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) ) (setq pt (getdxf s1 10) pt1 (getdxf s2 10) pt2 (getdxf s2 11) ) (if (= (rtos (+ (distance pt pt1) (distance pt pt2) ) 2 4 ) (rtos (distance pt1 pt2) 2 4) ) (getdxf s1 10) nil ) )
;;;点和圆弧的判断,判断出圆弧中点,利用inters函数知道点是不是在圆弧上 (defun POINT2ARC (x / s3 pt6 c r anga angb angmax angmin ac cen) ;(print "pt2arc") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) ) (setq pt6 (getdxf s1 10)) (setq c (getdxf s2 10)) (setq r (getdxf s2 40)) (if (= (rtos (distance c pt6) 2 4) (rtos r 2 4) ) (progn (setq anga (getdxf s2 50)) (setq angb (getdxf s2 51)) (setq angmax (max anga angb)) (setq angmin (min anga angb)) (if (= angmax angb) ;;;判断圆弧的中点 (progn (setq ac (* (- angmax angmin) r)) (setq cen (polar c (+ angmin (/ (- angmax angmin) 2.)) r)) ) (progn (setq angc (- (* 2. pi) (- angmax angmin))) (setq ac (* angc r)) (setq cen (polar c (+ angmax (/ angc 2.)) r)) ) ) (if (or (= 0 (distance pt6 cen)) (inters (polar c (getdxf s2 50) r) cen c pt6) (inters (polar c (getdxf s2 51) r) cen c pt6) ) (getdxf s1 10) nil ) ) ) )
;;;点和圆的判断,点到边的距离等于半径长 (defun POINT2CIRCLE (x / s3) ;(print "pt2c") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) ) (if (= (rtos (distance (getdxf s2 10) (getdxf s1 10)) 2 4) (rtos (getdxf s2 40) 2 4) ) (getdxf s1 10) nil ) )
;;;点和多线判断,把多线打散,循环调用点线函数 (defun POINT2LWPOLYLINE (x / temp ntemp sstemp s9 pt) ;(print "pt2pl") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) ) (setq temp (entget s2)) (entmake temp) (setq ntemp (entlast)) (command "explode" s2 "") (setq s2 (entnext ntemp)) (setq sstemp (ssadd)) (while s2 (setq s9 s2) (cond ((= (getdxf s2 0) "LINE") (if (POINT2LINE 0) (setq pt t) (setq pt nil) ) ) ((= (getdxf s2 0) "ARC")
(if (POINT2ARC 0) (setq pt t) (setq pt nil) ) ) ) (ssadd s9 sstemp) (setq s2 (entnext s9)) ) (command "erase" sstemp "") (if pt (getdxf s1 10) nil ) )
;;;线和线判断 (defun LINE2LINE (x /) (inters (getdxf s1 10) (getdxf s1 11) (getdxf s2 10) (getdxf s2 11) ) ) ;;;线和圆的判断,先判断圆心到线的距离,再判断圆心到线的垂足点,再判断圆线交点是否在线上 (defun LINE2CIRCLE (x / long1 long2 long3 s s3 r c pt1 pt2 ang dis_l2c ang inter s4 ) ;(print "l2c") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) ) (setq s4 s1) (setq r (getdxf s2 40)) (setq c (getdxf s2 10)) (setq pt1 (getdxf s1 10) pt2 (getdxf s1 11) ) (setq longa (distance pt1 pt2)) ;线长 (setq longb (distance pt1 c)) ;圆心端点一距离 (setq longc (distance pt2 c)) ;圆心端点二距离 (setq dis_l2c (geth longa longb longc)) ;圆心到直线距离 (setq ang (angle pt1 pt2)) ;直线的一个角度 ;;;判断垂足---> (setq inter (polar c (+ ang (/ pi 2.)) dis_l2c)) (setq pt nil) (while (not pt) (command "point" inter "") (setq s2 (entlast)) (if (or (= (rtos (angle inter pt1) 2 5) (rtos (angle inter pt2) 2 5) ) (POINT2LINE 1) ) (setq pt inter) (progn (setq pt t) (setq inter (polar c (- ang (/ pi 2.)) dis_l2c)) ) ) (entdel (entlast)) )
;;;<---判断垂足 (setq lst (list '())) (cond ((= r dis_l2c) ;相切情况 pt )
((> r dis_l2c) ;相交情况 (setq s2 (polar inter (+ pi ang) (sqrt (- (expt r 2.) (expt dis_l2c 2.))) ) ) (repeat 2 (command "point" s2 "") (setq s2 (entlast)) (setq s1 s4) (if (setq pt (POINT2LINE 1)) (setq lst (cons pt lst)) ) (entdel (entlast)) (setq s2 (polar inter ang (sqrt (- (expt r 2.) (expt dis_l2c 2.))) ) ) ) (filters lst) ) ) )
;;;线和圆弧,线和圆的交点(已经判断交点是否在线上)是否在圆弧上 (defun LINE2ARC (x / s3 s5 pt3 pta pt1) ;(print "l2a") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) ) (setq s5 s2) (setq pt3 (LINE2CIRCLE 0)) (setq lst2 (list '())) (setq s2 s5) (if (setq pta (car pt3)) (cond ((car (cdr pt3)) (repeat 2 (command "point" pta "") (setq s2 s5) (setq s1 (entlast)) (if (setq pt1 (POINT2ARC 0)) (setq lst2 (cons pt1 lst2)) ) (entdel (entlast)) (setq pta (cadr pt3)) ) (filters lst2) )
((not (car (cdr pt3))) (command "point" pta "") (setq s1 (entlast)) (setq s2 s5) (if (setq pt1 (POINT2ARC 0)) (setq lst2 (cons pt1 lst2)) ) (entdel (entlast)) (setq pta (cadr pt3)) (filters lst2) ) ) ) )
;;;线和多线,打散后判断线和线的交点 (defun LINE2LWPOLYLINE (x / s3 temp ntemp sstemp s11 pt) ;(print "l2pl") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) )
(setq temp (entget s2)) (entmake temp) (setq ntemp (entlast)) (command "explode" s2 "") (setq s2 (entnext ntemp)) (setq sstemp (ssadd)) (setq lst7 (list '())) (setq s10 s1) (while s2 (setq s11 s2) (setq s1 s10) (cond ((= (getdxf s2 0) "LINE") (if (setq pt (LINE2LINE 0)) (setq lst7 (cons pt lst7)) ) ) ((= (getdxf s2 0) "ARC") (if (setq pt (LINE2ARC 0)) (progn (if (cdr pt) (setq lst7 (cons (car pt) (cons (cadr pt) lst7))) (setq lst7 (cons (car pt) lst7)) ) ) ) ) ) (ssadd s11 sstemp) (setq s2 (entnext s11)) ) (command "erase" sstemp "") (if (cdr lst7) (filters lst7) (setq pt nil) ) )
;;;圆和圆,算出弦长,弦中心点,得到两个交点 (defun CIRCLE2CIRCLE (x / r1 r2 c1 c2 dis ang chord2 ptc pt1 pt2 pta ptb ptc) ;(print "c2c") (setq r1 (getdxf s1 40)) (setq r2 (getdxf s2 40)) (setq c1 (getdxf s1 10)) (setq c2 (getdxf s2 10)) (setq dis (distance c1 c2)) (setq ang (angle c1 c2)) (cond ((< (+ dis (min r1 r2)) (max r1 r2)) nil ) ((= (rtos (+ r1 r2) 2 4) (rtos dis 2 4)) ;;;一个交点的情况 (setq pt (polar c1 ang r1)) (command "point" pt "") (setq s1 (entlast)) (if (POINT2CIRCLE 0) (progn (entdel (entlast)) pt ) (progn (entdel (entlast)) (setq pt (polar c1 (+ pi ang) r1)) ) ) ) ((> (+ r1 r2) dis) ;;;两个交点的情况 (setq chord2 (geth dis r1 r2)) ;;;弦长的一半 (setq lst (list '())) (setq ptc (polar c1 ang (sqrt (- (expt r1 2) (expt chord2 2)))) ) (setq pt1 (polar ptc (+ ang (/ pi 2.)) chord2)) (setq pt2 (polar ptc (- ang (/ pi 2.)) chord2)) (command "point" pt1 "") (setq s1 (entlast)) (if (POINT2CIRCLE 0) (setq pta t) (setq pta nil) ) (entdel (entlast)) (command "point" pt2 "") (setq s1 (entlast)) (if (POINT2CIRCLE 0) (setq ptb t) (setq ptb nil) ) (entdel (entlast)) (if (or (= pta t) (= ptb t)) (progn (setq lst (filters (cons pt1 (cons pt2 lst)))) ) (progn (setq ptc (polar c1 (+ pi ang) (sqrt (- (expt r1 2) (expt chord2 2))) ) ) (setq pt1 (polar ptc (+ ang (/ pi 2.)) chord2)) (setq pt2 (polar ptc (- ang (/ pi 2.)) chord2)) (setq lst (filters (cons pt1 (cons pt2 lst)))) ) ) ) )
) ;;;圆和圆弧,获取两圆交点,判断交点是否在圆弧上 (defun CIRCLE2ARC (x / s3 pt1 pt2) ;(print "c2a") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) ) (if (setq lst (CIRCLE2CIRCLE 0)) (cond ((car (cdr lst))
(setq pt1 (car lst)) (setq pt2 (cadr lst)) (setq lst (list '())) (repeat 2 (command "point" pt1 "") (setq s1 (entlast)) (if (POINT2ARC 0) (setq lst (cons pt1 lst)) ) (entdel (entlast)) (setq pt1 pt2) ) (filters lst) ) ((not (car (cdr lst))) (setq pt1 (car lst)) (setq lst (list '()))
(command "point" pt1 "") (setq s1 (entlast)) (if (POINT2ARC 0) (setq lst (cons pt1 lst)) ) (entdel (entlast))
(setq pt1 pt2) (filters lst) ) ) nil ) )
;;;圆和多线,打散后调用线和圆相交函数 (defun CIRCLE2LWPOLYLINE (x / s3 s8 temp ntemp sstemp pt i2) ;(print "c2pl") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) ) (setq s8 s1) (setq temp (entget s2)) (entmake temp) (setq ntemp (entlast)) (command "explode" s2 "") (setq s2 (entnext ntemp)) (setq sstemp (ssadd)) (setq lst6 (list '())) (while s2 (ssadd s2 sstemp) (setq s2 (entnext s2)) ) (setq i2 0) (setq len (sslength sstemp)) (repeat len (setq s2 s8) (setq s1 (ssname sstemp i2)) (cond ((= "LINE" (getdxf s1 0)) (if (setq pt (LINE2CIRCLE 0)) (progn (if (cdr pt) (setq lst6 (cons (car pt) (cons (cadr pt) lst6))) (setq lst6 (cons (car pt) lst6)) ) ) ) ) ((= "ARC" (getdxf s1 0)) (if (setq pt (CIRCLE2ARC 1)) (progn (if (cdr pt) (setq lst6 (cons (car pt) (cons (cadr pt) lst6))) (setq lst6 (cons (car pt) lst6)) ) ) ) ) ) (setq i2 (1+ i2)) ) (command "erase" sstemp "") (if (cdr lst6) (filters lst6) nil ) )
;;;圆弧和圆弧,获取两圆交点,判断该点是否在圆弧上 (defun ARC2ARC (x / s13 s14 pt pta pt1) ;(print "a2a") (setq s13 s1) (setq s14 s2) (setq pt (CIRCLE2ARC 0)) (setq lst2 (list '())) (if (setq pta (car pt)) (cond ((car (cdr pt)) (repeat 2 (command "point" pta "") (setq s1 (entlast)) (setq s2 s13) (if (setq pt1 (POINT2ARC 0)) (setq lst2 (cons pt1 lst2)) ) (entdel (entlast)) (setq pta (cadr pt)) ) (filters lst2) )
((not (car (cdr pt))) (command "point" pta "") (setq s1 (entlast)) (setq s2 s13) (if (setq pt1 (POINT2ARC 0)) (setq lst2 (cons pt1 lst2)) ) (entdel (entlast)) (setq pta (cadr pt)) (filters lst2) ) (nil t) ) nil ) ) ;;;圆弧和多线,打散调用线和圆弧判断函数 (defun ARC2LWPOLYLINE (x / s3 temp ntemp sstemp s6 i len pt) ;(print "a2lw") (if (= x 1) (progn (setq s3 s1) (setq s1 s2) (setq s2 s3) ) ) (setq temp (entget s2)) (entmake temp) (setq ntemp (entlast)) (command "explode" s2 "") (setq s2 (entnext ntemp)) (setq sstemp (ssadd)) (setq lst4 (list '())) (while s2 (ssadd s2 sstemp) (setq s2 (entnext s2)) ) (setq i 0) (setq len (sslength sstemp)) (setq s6 s1) (repeat len (setq s2 (ssname sstemp i)) (cond ((= "LINE" (getdxf s2 0)) (if (setq pt (LINE2ARC 1)) (progn (if (cdr pt) (setq lst4 (cons (car pt) (cons (cadr pt) lst4))) (setq lst4 (cons (car pt) lst4)) ) ) ) ) ((= "ARC" (getdxf s2 0)) (if (setq pt (ARC2ARC 0)) (progn (if (cdr pt) (setq lst4 (cons (car pt) (cons (cadr pt) lst4))) (setq lst4 (cons (car pt) lst4)) ) ) ) ) ) (setq s1 s6) (setq i (1+ i)) ) (command "erase" sstemp "") (if (cdr lst4) (filters lst4) nil ) )
;;;多线和多线判断 (defun LWPOLYLINE2LWPOLYLINE (x / temp1 ntemp1 temp2 ntemp1 ntemp2 sstemp1 sstemp2 len1 len2 i j pta ptb ptc ptd s15 ) ;(print "pl2pl") (setq temp1 (entget s1)) (entmake temp1) (setq ntemp1 (entlast)) (command "explode" s1 "") (setq s1 (entnext ntemp1)) (setq sstemp1 (ssadd)) (setq lst5 (list '())) (while s1 (ssadd s1 sstemp1) (setq s1 (entnext s1)) ) (setq temp2 (entget s2)) (entmake temp2) (setq ntemp2 (entlast)) (command "explode" s2 "") (setq s2 (entnext ntemp2)) (setq sstemp2 (ssadd)) (while s2 (ssadd s2 sstemp2) (setq s2 (entnext s2)) ) (setq i 0) (setq len1 (sslength sstemp1)) (setq len2 (sslength sstemp2)) (repeat len1 (setq s1 (ssname sstemp1 i)) (setq s15 s1) (setq j 0) (cond ((= "LINE" (getdxf s1 0)) (repeat len2 (setq s2 (ssname sstemp2 j)) (cond ((= "LINE" (getdxf s2 0)) (setq s1 s15) (setq pta (getdxf s1 10) ptb (getdxf s1 11) ptc (getdxf s2 10) ptd (getdxf s2 11) ) (if (setq pt (inters pta ptb ptc ptd)) (setq lst5 (cons pt lst5)) ) ) ((= "ARC" (getdxf s2 0)) (setq s1 s15) (if (setq pt (LINE2ARC 0)) (progn (if (cdr pt) (setq lst5 (cons (car pt) (cons (cadr pt) lst5))) (setq lst5 (cons (car pt) lst5)) ) ) ) ) ) (setq j (1+ j)) ) (setq i (1+ i)) ) ((= "ARC" (getdxf s1 0)) (repeat len2 (setq s2 (ssname sstemp2 j)) (cond ((= "LINE" (getdxf s2 0)) (setq s1 s15) (if (setq pt (LINE2ARC 1)) (progn (if (cdr pt) (setq lst5 (cons (car pt) (cons (cadr pt) lst5))) (setq lst5 (cons (car pt) lst5)) ) ) ) ) ((= "ARC" (getdxf s2 0)) (setq s1 s15) (if (setq pt (ARC2ARC 0)) (progn (if (cdr pt) (setq lst5 (cons (car pt) (cons (cadr pt) lst5))) (setq lst5 (cons (car pt) lst5)) ) ) ) ) ) (setq j (1+ j)) ) (setq i (1+ i)) ) ) )
(command "erase" sstemp1 sstemp2 "") (if (cdr lst5) (filters lst5) nil ) )
(setq dxf_name1 (getdxf s1 0)) (setq dxf_name2 (getdxf s2 0))
;;;图元类型判断 (cond ;;;点类型判断 ((= dxf_name1 "POINT") (cond ((= dxf_name2 "POINT") (POINT2POINT 0) ) ((= dxf_name2 "LINE") (POINT2LINE 0) ) ((= dxf_name2 "ARC") (POINT2ARC 0) ) ((= dxf_name2 "CIRCLE") (POINT2CIRCLE 0) ) ((= dxf_name2 "POLYLLINE") (POINT2LWPOLYLINE 0) ) ((= dxf_name2 "LWPOLYLINE") (POINT2LWPOLYLINE 0) ) (T nil) ) ) ;;;线类型判断 ((= dxf_name1 "LINE") (cond ((= dxf_name2 "LINE") (LINE2LINE 0) ) ((= dxf_name2 "POINT") (POINT2LINE 1) ) ((= dxf_name2 "ARC") (LINE2ARC 0) ) ((= dxf_name2 "CIRCLE") (LINE2CIRCLE 0) ) ((= dxf_name2 "POLYLLINE") (LINE2LWPOLYLINE 0) ) ((= dxf_name2 "LWPOLYLINE") (LINE2LWPOLYLINE 0) ) (T nil) ) ) ;;;圆类型判断 ((= dxf_name1 "CIRCLE") (cond ((= dxf_name2 "POINT") (POINT2CIRCLE 1) ) ((= dxf_name2 "LINE") (LINE2CIRCLE 1) ) ((= dxf_name2 "CIRCLE") (CIRCLE2CIRCLE 0) ) ((= dxf_name2 "ARC") (CIRCLE2ARC 0) ) ((= dxf_name2 "POLYLLINE") (CIRCLE2LWPOLYLINE 0) ) ((= dxf_name2 "LWPOLYLINE") (CIRCLE2LWPOLYLINE 0) ) (T nil) ) )
;;;圆弧断 ((= dxf_name1 "ARC") (cond ((= dxf_name2 "POINT") (POINT2ARC 1) ) ((= dxf_name2 "LINE") (LINE2ARC 1) ) ((= dxf_name2 "CIRCLE") (CIRCLE2ARC 1) ) ((= dxf_name2 "ARC") (ARC2ARC 0) ) ((= dxf_name2 "POLYLLINE") (ARC2LWPOLYLINE 0) ) ((= dxf_name2 "LWPOLYLINE") (ARC2LWPOLYLINE 0) ) (T nil) ) )
;;;多线判断 ((= dxf_name1 "LWPOLYLINE") (cond ((= dxf_name2 "POINT") (POINT2LWPOLYLINE 1) ) ((= dxf_name2 "LINE") (LINE2LWPOLYLINE 1) ) ((= dxf_name2 "CIRCLE") (CIRCLE2LWPOLYLINE 1) ) ((= dxf_name2 "ARC") (ARC2LWPOLYLINE 1) ) ((= dxf_name2 "POLYLLINE") (LWPOLYLINE2LWPOLYLINE 0) ) ((= dxf_name2 "LWPOLYLINE") (LWPOLYLINE2LWPOLYLINE 0) ) (T nil) ) )
(T nil) ) ) ;(if (= dxf_name1 "LINE"))
;;;临时 (setq a (car (entsel "选取一个图元(POINT/LINE/ARC/PLINE/CIRCLE)"))) (print "---->") (print "------->") (print "---------->") (setq b (car (entsel "选取另外一个图元(POINT/LINE/ARC/PLINE/CIRCLE)") ) ) (setq return (getinter a b)) (setvar "osmode" osm) (if return return (print "没有交点") ) ) |