[编程交流] 绘制平分线

(setq a (getkword (strcat "\n Bisector Type - Angula /Linear <" ad ">:   ")))

(setq a (getkword (strcat "\n Bisector Type - [color="red"][b][[/b][/color]Angula/Linear[color="red"][b]][/b][/color] <" ad ">:   ")))

(LM:intersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2) acextendboth)

(defun LM:intersections ( ob1 ob2 mod / lst rtn )
(setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
(repeat (/ (length lst) 3)
        (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                lst (cdddr lst)
        )
)
(reverse rtn)
)

;;;;;;;;;;;;;BY YJR111 2011-11-19;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:bisect(/ fglst please input others youself 3q vla_e1 vla_e2)
(vl-load-com)
(SETQ oldosmode(GETVAR  "OSMODE" ))
(SETQ oldltscale(GETVAR  "ltscale" ))
(SETQ oldceltscale(GETVAR  "celtscale" ))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "ltscale" 1)
(setvar "celtscale" 1)
(setvar "cecolor" "1")
(command "linetype" "s" "center" "")
(setq sss(ssadd))
(setq 
        myms(vla-get-modelspace (setq mydoc(vla-get-activedocument(vlax-get-acad-object))))
       myss(vla-get-SelectionSets mydoc)
        myutility(vla-get-utility mydoc)
       mylayer(vla-get-layers mydoc)
        mylinetypes(vla-get-linetypes mydoc)
)
(initget 6)
(if (and(=(type *num_fenge*)'int)*num_fenge*) 
        (setq num_fenge (getint (strcat "\nNumber Of Bisector Lines<" (rtos *num_fenge* 2 0)">")))
        (progn
                (setq num_fenge (getint  "\nNumber Of Bisector Lines" ))
                (if (/=(type num_fenge)'int)
                        (progn
                                (princ"\nNumber type is wrong, please enter the integer!")
                                (setq num_fenge (getint  "\nNumber Of Bisector Lines" ))
                        )
                )
        )
)
(if (not num_fenge)
        (setq num_fenge *num_fenge*)
        (setq *num_fenge* num_fenge )
)
(while
        (and
                (setq e1 (car(setq nentsel_e1(nentselp"\nChoose first line :"))))
                (setq e2 (car(setq nentsel_e2(nentselp"\nChoose second line :"))))
        )
        (setq point_e1 (cadr nentsel_e1))
        (setq s1 (entget e1))
        (setq point_e2 (cadr nentsel_e2))
        (setq s2 (entget e2))
        (setq vla_e1(vlax-ename->vla-object e1))
        (setq vla_e2(vlax-ename->vla-object e2))
        (if (<= (length nentsel_e1) 2)
                (setq point_e1(vlax-curve-getClosestPointTo vla_e1 point_e1 ))
                ;;OCS<=>WCS
                (progn
                        (setq 
                                vla_ee1 (vlax-ename->vla-object(caar(reverse nentsel_e1)))
                                xsca(vla-get-XScaleFactor vla_ee1)
                                ysca(vla-get-YScaleFactor vla_ee1)
                                zsca(vla-get-ZScaleFactor vla_ee1)
                                rto(vla-get-rotation vla_ee1)
                                insertp(cdr(assoc 10(entget(caar(reverse nentsel_e1)))))
                        )
                        (setq shuzu1 (caddr nentsel_e1))
                        (setq variant_shuzu1 (vlax-make-safearray  vlax-vbDouble '(0 . 3)'(0 . 3) ))
                        (command "undo" "be" )
                        (vlax-safearray-fill variant_shuzu1 shuzu1)
                        (vla-transformby vla_e1 variant_shuzu1)
                        (command "undo" "e" )
                        (setq point_e1(vlax-curve-getClosestPointTo vla_e1 point_e1 ))
                        (command "undo" 1 )
                )
        )        
        (if (<= (length nentsel_e2) 2)
                (setq point_e2(vlax-curve-getClosestPointTo vla_e2 point_e2 ))
                ;;OCS<=>WCS
                (progn
                        (setq 
                                vla_ee2 (vlax-ename->vla-object(caar(reverse nentsel_e2)))
                                xsca(vla-get-XScaleFactor vla_ee2)
                                ysca(vla-get-YScaleFactor vla_ee2)
                                zsca(vla-get-ZScaleFactor vla_ee2)
                                rto(vla-get-rotation vla_ee2)
                                insertp(cdr(assoc 10(entget(caar(reverse nentsel_e2)))))
                        )
                        (setq shuzu2 (caddr nentsel_e2))
                        (setq variant_shuzu2 (vlax-make-safearray  vlax-vbDouble '(0 . 3)'(0 . 3) ))
                        (command "undo" "be" )
                        (vlax-safearray-fill variant_shuzu2 shuzu2)
                        (vla-transformby vla_e2 variant_shuzu2)
                        (command "undo" "e" )
                        (setq point_e2(vlax-curve-getClosestPointTo vla_e2 point_e2 ))
                        (command "undo" 1 )
                )
        )
        (if (=(vla-get-objectname vla_e1)"AcDbLine" )
                (progn
                        (changedxf10<->11  s1)
                        (entupd e1)
                        (setq s1 ss ss nil )
                        (setq 
                                dxf10_e1(cdr (assoc 10 s1))
                                dxf11_e1(cdr (assoc 11 s1))
                        )
                        (setq vla_e1_ang(vla-get-angle vla_e1)) 
                )
        )
        (if (=(vla-get-objectname vla_e2)"AcDbLine" )
                (progn
                        (changedxf10<->11  s2)
                        (entupd e2)
                        (setq s2 ss ss nil)
                        (setq 
                                dxf10_e2(cdr (assoc 10 s2))
                                dxf11_e2(cdr (assoc 11 s2))
                        )
                        (setq vla_e2_ang(vla-get-angle vla_e2)) 
                )
        )
        (if (=(vla-get-objectname vla_e1)"AcDbPolyline" )
                (progn
                        (setq pline1_dxf10(vla-get-coordinates vla_e1))
                        (setq dxf_e1 (vlax-safearray->list(vlax-variant-value pline1_dxf10)))
                        (setq  fglst nil)
                        (fgb dxf_e1)
                        (setq dxf10_lst fglst n 0)
                        (if (> (length nentsel_e1) 2)
                                (progn
                                        (setq dxf10_lst(mapcar (function(lambda(x)(trans  x (caar(reverse nentsel_e1)) 0)))dxf10_lst))
                                        (setq dxf10_lst(mapcar (function(lambda(x)(ocs->wcs x shuzu1)))dxf10_lst))
                                )
                        )
                        (while(< n (length dxf10_lst))
                                (cond 
                                        ((< n (1-(length dxf10_lst)))(setq nthn1 (nth n dxf10_lst))(setq nthn2 (nth (1+ n) dxf10_lst)))
                                        ((= n (1-(length dxf10_lst)))(setq nthn1 (nth n dxf10_lst))(setq nthn2 (nth 0 dxf10_lst)))
                                )
                                (setq point_ee1(vlax-curve-getClosestPointTo (setq vla_e1(vla-addline myms (vlax-3d-point nthn1)(vlax-3d-point nthn2)))point_e1 ))
                                (if 
                                        (not 
                                                (and
                                                        (equal (car point_e1)(car point_ee1) 1e-3)
                                                        (equal (cadr point_e1)(cadr point_ee1) 1e-3)
                                                        (equal (caddr point_e1)(caddr point_ee1) 1e-3)
                                                )
                                        )
                                        (progn
                                                (vla-delete vla_e1)
                                                (setq n(1+ n))
                                        )
                                        (progn
                                                (setq e1(vlax-vla-object->ename vla_e1))
                                                (setq s1 (entget e1))
                                                (setq sss (ssadd))
                                                (setq sss(ssadd e1 sss ))
                                                (setq n (length dxf10_lst))
                                        )
                                )
                        )
                        (if (=(vla-get-objectname vla_e1)"AcDbLine" )
                                (progn
                                        (changedxf10<->11 s1)
                                        (setq s1 ss ss nil)
                                        (entupd e1)
                                        (setq 
                                                dxf10_e1(cdr (assoc 10 s1))
                                                dxf11_e1(cdr (assoc 11 s1))
                                        )
                                        (setq vla_e1_ang(vla-get-angle vla_e1)) 
                                )
                        )                         
                )
        )
        (if (=(vla-get-objectname vla_e2)"AcDbPolyline" )
                (progn
                        (setq pline2_dxf10(vla-get-coordinates vla_e2))
                        (setq dxf_e2 (vlax-safearray->list(vlax-variant-value pline2_dxf10)))
                        (setq  fglst nil)
                        (fgb dxf_e2)
                        (setq dxf10_lst fglst n 0)
                        (if (> (length nentsel_e2) 2)
                                (progn
                                        (setq dxf10_lst(mapcar (function(lambda(x)(trans  x (caar(reverse nentsel_e2)) 0)))dxf10_lst))
                                        (setq dxf10_lst(mapcar (function(lambda(x)(ocs->wcs x shuzu2)))dxf10_lst))
                                )
                        )
                        (while(< n (length dxf10_lst))
                                (cond 
                                        ((< n (1-(length dxf10_lst)))(setq nthn1 (nth n dxf10_lst))(setq nthn2 (nth (1+ n) dxf10_lst)))
                                        ((= n (1-(length dxf10_lst)))(setq nthn1 (nth n dxf10_lst))(setq nthn2 (nth 0 dxf10_lst)))
                                )
                                (setq point_ee2(vlax-curve-getClosestPointTo (setq vla_e2(vla-addline myms (vlax-3d-point nthn1)(vlax-3d-point nthn2)))point_e2 ))
                                (if 
                                        (not 
                                                (and
                                                        (equal (car point_e2)(car point_ee2) 1e-3)
                                                        (equal (cadr point_e2)(cadr point_ee2) 1e-3)
                                                        (equal (caddr point_e2)(caddr point_ee2) 1e-3)
                                                )
                                        )
                                        (progn
                                                (vla-delete vla_e2)
                                                (setq n(1+ n))
                                        )
                                        (progn
                                                (setq e2(vlax-vla-object->ename vla_e2))
                                                (setq s2 (entget e2))
                                                (setq sss(ssadd e2 sss ))
                                                (setq n (length dxf10_lst))
                                        )
                                )
                        )
                        (if (=(vla-get-objectname vla_e2)"AcDbLine" )
                                (progn
                                        (changedxf10<->11  s2)
                                        (entupd e2)
                                        (setq s2 ss ss nil)
                                        (setq 
                                                dxf10_e2(cdr (assoc 10 s2))
                                                dxf11_e2(cdr (assoc 11 s2))
                                        )
                                        (setq vla_e2_ang(vla-get-angle vla_e2)) 
                                )
                        )
                )   
        )
        (cond
                (
                        (or
                                (EQUAL  vla_e1_ang vla_e2_ang 1E-4)
                                (EQUAL (abs(-  vla_e1_ang vla_e2_ang )) pi 1e-4)
                        )
                        
                        (setq n 1)
                        (repeat (1- *num_fenge*)
                                (if 
                                        (and
                                                (=(cdr(assoc 0(entget(car nentsel_e1))))"LINE" )
                                                (=(cdr(assoc 0(entget(car nentsel_e2))))"LINE" )
                                                (/=(last (cadr shuzu1))0)
                                                (/=(last (cadr shuzu2))0)
                                                (> (length nentsel_e1) 2)
                                                (> (length nentsel_e2) 2)
                                        )
                                        (progn
                                                (command "undo" "be" )
                                                (vlax-safearray-fill variant_shuzu1 shuzu1)
                                                (vla-transformby vla_e1 variant_shuzu1)
                                                (vlax-safearray-fill variant_shuzu2 shuzu2)
                                                (vla-transformby vla_e2 variant_shuzu2)
                                                (command "undo" "e" )
                                                (setq point_e1_start(3d->2d(vlax-safearray->list(vlax-variant-value(vla-get-startpoint vla_e1  )))))
                                                (setq point_e1_end(3d->2d(vlax-safearray->list(vlax-variant-value(vla-get-endpoint vla_e1  )))))
                                                (if (>(cadr point_e1_start)(cadr point_e1_end))
                                                        (progn
                                                                (setq point_e1_start(list (car point_e1_start)(cadr point_e1_end)0.0))
                                                                (setq point_e1_end(list (car point_e1_end)(cadr point_e1_start)0.0))
                                                        )
                                                )
                                                (setq point_e2_start(3d->2d(vlax-safearray->list(vlax-variant-value(vla-get-startpoint vla_e2  )))))
                                                (setq point_e2_end(3d->2d(vlax-safearray->list(vlax-variant-value(vla-get-endpoint vla_e2  )))))
                                                (if (>(cadr point_e2_start)(cadr point_e2_end))
                                                        (progn
                                                                (setq point_e2_start(list (car point_e2_start)(cadr point_e2_end)0.0))
                                                                (setq point_e2_end(list (car point_e2_end)(cadr point_e2_start)0.0))
                                                        )
                                                )
                                                (command "undo" 1 )
                                                (setq myline(vla-addline myms (vlax-3d-point point_e1_start)(vlax-3d-point point_e1_end)))
                                                (setq dist_num(/(distance dxf10_e1 dxf10_e2) *num_fenge* ))
                                                (vla-move myline  (vlax-3d-point point_e1_start) (vlax-3d-point(polar point_e1_start (angle point_e1_start point_e2_start) (* dist_num n))))
                                        )
                                        (progn
                                                (setq myline(vla-copy  vla_e1))
                                                (setq dist_num(/(distance dxf10_e1 dxf10_e2) *num_fenge* ))
                                                (vla-move myline  (vlax-3d-point dxf10_e1) (vlax-3d-point(polar dxf10_e1 (angle dxf10_e1 dxf10_e2) (* dist_num n))))
                                        )
                                )
                                (setq n (1+ n))
                        )
                        (princ (strcat "\nBisect distance is " (rtos dist_num 2 2) ))
                )
                (
                        (and
                                (/= vla_e1_ang vla_e2_ang)
                                (wcmatch(vla-get-objectname vla_e1)"*Line" )
                        )
                        (if (setq inters_e1_e2 (inters dxf10_e1 dxf11_e1 dxf10_e2 dxf11_e2 ))
                                (progn
                                        (setq myline1 (vla-addline myms (vlax-3d-point inters_e1_e2) (vlax-3d-point point_e1)))
                                        (setq myline1_ang(vla-get-angle myline1))
                                        (setq myline2 (vla-addline myms (vlax-3d-point inters_e1_e2) (vlax-3d-point point_e2)))
                                        (setq myline2_ang(vla-get-angle myline2))
                                        (if 
                                                (or
                                                        (and(>= myline1_ang pi )(>= myline2_ang pi ))
                                                        (and(<= myline1_ang pi )(<= myline2_ang pi ))
                                                        (and (> myline1_ang (/ pi 2))(< myline1_ang myline2_ang))
                                                        (and(> myline1_ang myline2_ang)(> (* 1.5 pi) myline1_ang pi ))
                                                )
                                                (setq  inters_angle (- myline1_ang  myline2_ang))
                                                (progn
                                                        (if (< myline1_ang myline2_ang)
                                                                (setq  inters_angle (- myline1_ang  (- myline2_ang (* 2 pi))))
                                                                (setq  inters_angle (-(- myline1_ang (* 2 pi)) myline2_ang ))
                                                        )
                                                )
                                        )
                                        (repeat (1- *num_fenge*)
                                                (setq angle_num (* -1(/ inters_angle *num_fenge*)))
                                                (vla-rotate myline1 (vlax-3d-point inters_e1_e2)  angle_num)
                                                (setq myline1(vla-copy myline1))
                                        )
                                        (vla-delete myline2)
                                        (princ (strcat "\nBisect angle is " (rtos (abs(*(/ angle_num pi)180)) 2 2) ))
                                )
                                (progn
                                        (if (setq inters_e1_e2 (inters dxf10_e1 dxf11_e1 dxf10_e2 dxf11_e2 nil))
                                                (progn
                                                        (setq inters_e1_angle (angle inters_e1_e2 dxf10_e1))
                                                        (setq inters_e2_angle (angle inters_e1_e2 dxf10_e2))
                                                        (if (> inters_e1_angle inters_e2_angle)
                                                                (setq myline(vla-addline myms (vlax-3d-point inters_e1_e2)
                                                                (vlax-3d-point(polar inters_e1_e2 (setq inters_angle(+(/(- inters_e1_angle inters_e2_angle)2)inters_e2_angle))(vla-get-length vla_e1)))))
                                                                (setq myline(vla-addline myms (vlax-3d-point inters_e1_e2)
                                                                (vlax-3d-point(polar inters_e1_e2 (setq inters_angle(+(/(- inters_e2_angle inters_e1_angle)2)inters_e1_angle))(vla-get-length vla_e1)))))
                                                        )
                                                        (vla-move myline (vlax-3d-point inters_e1_e2) 
                                                                (if (>= inters_angle  pi )
                                                                        (vlax-3d-point (polar dxf11_e1 (angle dxf11_e1 dxf11_e2)(/(distance dxf11_e1 dxf11_e2)2)))
                                                                        (vlax-3d-point (polar dxf10_e1 (angle dxf10_e1 dxf10_e2)(/(distance dxf10_e1 dxf10_e2)2)))
                                                                ) 
                                                        )
                                                )
                                        )
                                        (princ (strcat "\nBisect angle is" (rtos (abs(*(/ (if (> inters_angle pi)(setq inters_angle (- inters_angle (* 1.5 pi) ))inters_angle)pi) 180)) 2 2) ))
                                )
                        )
                )
        )
        (if (or(=(vla-get-objectname vla_e1)"AcDbCircle" )(=(vla-get-objectname vla_e1)"AcDbArc" ))
                (progn
                        (setq 
                                center (vla-get-center vla_e1)
                                radius (vla-get-radius vla_e1)
                        )
                        (cond
                                ((=(vla-get-objectname vla_e1)"AcDbArc" )
                                        (setq 
                                                myline (vla-addline myms center (vla-get-startpoint vla_e1))
                                                angle_total  (vla-get-totalangle vla_e1)
                                        ) 
                                )
                                (t
                                        (setq 
                                                myline (vla-addline myms center (vlax-3d-point point_e1))
                                                angle_total  (* pi 2)
                                        )
                                )
                        )
                        (setq n 1)
                        (repeat (1- *num_fenge*)
                                (setq myline(vla-copy  myline))
                                (setq angle_num (/  angle_total   *num_fenge*)) 
                                (vla-rotate myline center angle_num)
                                (setq n (1+ n))
                        )
                        (princ (strcat "\nBisect angle is" (rtos (abs(*(/ angle_num pi)180)) 2 2) ))
                )
        )
        (setq n 0)
        (if (>(sslength sss)0)
                (repeat (sslength sss)
                        (command "erase" (ssname sss n) "")
                        (setq n(1+ n))
                )
        )
)
(SETvar  "osmode" oldosmode)
(SETvar  "ltscale" oldltscale)
(princ "\n Thanks for use bisect tools, by yjr111")
(princ)
)
;;;(setq lst '(20882.6 12429.7 35344.0 12429.7 35344.0 8473.39 20882.6 8473.39))
;;;(fgb lst) ((20882.6 12429.7)(35344.0 12429.7)(35344.0 8473.39)(20882.6 8473.39))
(defun fgb(lst / fglst1 dxf10 n)
(setq n 0 i 0)
(repeat (/(length lst)2)
        (repeat 2
                (setq  dxf10 (nth n lst))
                (setq fglst1 (append fglst1 (list dxf10 )))
                (setq n (1+ n))
        )
        (setq fglst (append  fglst (list fglst1 )))
        (setq fglst1 nil)
        (setq i(1+ i))
)
)
(defun changedxf10<->11(s)
(cond
        ((or
                (> (cadr (cdr(assoc 10 s))) (cadr (cdr(assoc 11 s))))
                (and
                        (= (cadr (cdr(assoc 10 s))) (cadr (cdr(assoc 11 s))))
                        (>(car (cdr(assoc 10 s))) (car (cdr(assoc 11 s))))
                )
        )
        (setq s(subst (cons 12 (cdr(assoc 10 s))) (assoc 10 s) s))
        (setq s(subst (cons 10 (cdr(assoc 11 s))) (assoc 11 s) s))
        (setq s(subst (cons 11 (cdr(assoc 12 s))) (assoc 12 s) s))
        (entmod s)
        )
)
(setq ss s)
)
;;ocs->wcs
(defun ocs->wcs(p1 shuzu )
(setq shuzu_nth0 (nth 0 shuzu) shuzu_nth1 (nth 1 shuzu) shuzu_nth2 (nth 2 shuzu) shuzu_nth3 (nth 3 shuzu))
(setq trans_point 
        (list 
                (+(*(car p1)(car shuzu_nth0))(*(cadr p1)(cadr shuzu_nth0))(*(caddr p1)(caddr shuzu_nth0))(cadddr shuzu_nth0) )
                (+(*(car p1)(car shuzu_nth1))(*(cadr p1)(cadr shuzu_nth1))(*(caddr p1)(caddr shuzu_nth1))(cadddr shuzu_nth1) )
                (+(*(car p1)(car shuzu_nth2))(*(cadr p1)(cadr shuzu_nth2))(*(caddr p1)(caddr shuzu_nth2))(cadddr shuzu_nth2) )
        )
)
   (setq point_e trans_point)
)
;;3Dpoint->2Dpoint
(defun 3d->2d(p)
(setq p (list(car p)(cadr p)0.0))
)

(defun c:bisect 
(
        / 
        ent1
        ent2
        int
        e1 
        ss 
        e2 
        d1 
        p10 
        p11 
        d2 
        p20 
        p21 
        p30 
        p31
        a 
        ad 
        q 
        a1 
        s1 
        p1 
        a2 
        s2 
        p2
        vp 
        sa 
        ea 
        ia 
        i
)
(if
        (and
                (setq ent1 (select_e "LINE" "\n>>>Choose first line : ")) 
                (setq ent2 (select_e "LINE" "\n>>>Choose second line : ")) 
        )
        (progn
                (initget 7)
                (setq q (getint "\nNumber Of Bisector Lines: "))
                (setq e1 (car ent1))
                (setq e2 (car ent2))
                (redraw e1 3)
                (redraw e2 3)
                (setq int(LM:intersections (vlax-ename->vla-object e1) (vlax-ename->vla-object e2) acextendboth))
                (cond 
                        ((= int nil)
                                (setq 
                                        d1 (entget e1)
                                        p10 (cdr (assoc 10 d1))
                                        p11 (cdr (assoc 11 d1))
                                )
                                (setq 
                                        d2 (entget e2)
                                        p20 (cdr (assoc 10 d2))
                                        p21 (cdr (assoc 11 d2))
                                )
                                (if(inters p10 p20 p11 p21)
                                        (setq 
                                                p30 p21
                                                p31 p20
                                        )
                                        (setq 
                                                p30 p20
                                                p31 p21
                                        )
                                )
                                (setq 
                                        a1 (angle p10 p30)
                                        s1 (/ (distance p10 p30) (+ q 1))
                                        p1 (polar p10 a1 s1)
                                )
                                (setq 
                                        a2 (angle p11 p31)
                                        s2 (/ (distance p11 p31) (+ q 1))
                                        p2 (polar p11 a2 s2)
                                )
                                (grdraw p10 p10 2)
                                (grdraw p11 p11 3)
                                (repeat q
                                        (entmake 
                                                (list 
                                                        (cons 0 "LINE")
                                                        (cons 62 1)
                                                        (cons 10 p1)
                                                        (cons 11 p2)
                                                )
                                        )
                                        (setq 
                                                p1 (polar p1 a1 s1)
                                                p2 (polar p2 a2 s2)
                                        )
                                )
                        )
                        (int
                                (setq ed1 (entget e1))
                                (setq ed2 (entget e2))
                                (SETVAR "FILLETRAD" 0)
                                (command "_.fillet" ent1 ent2)
                                (setq 
                                        d1 (entget e1)
                                        p10 (cdr (assoc 10 d1))
                                        p11 (cdr (assoc 11 d1))
                                )
                                (setq 
                                        d2 (entget e2)
                                        p20 (cdr (assoc 10 d2))
                                        p21 (cdr (assoc 11 d2))
                                )
                                (cond 
                                        ((equal p10 p20 1e- (setq vp p10 p1 p11 p2 p21))
                                        ((equal p10 p21 1e- (setq vp p10 p1 p11 p2 p20))
                                        ((equal p11 p20 1e- (setq vp p11 p1 p10 p2 p21))
                                        ((equal p11 p21 1e- (setq vp p11 p1 p10 p2 p20))
                                )
                                (if(gc:clockwise-p p1 vp p2)
                                        (setq 
                                                sa (angle vp p1)
                                                ea (angle vp p2)
                                        )
                                        (setq 
                                                ea (angle vp p1)
                                                sa (angle vp p2)
                                        )
                                )
                                (setq ia (if (> sa ea)(+ (- (* 2 pi) sa) ea)(- ea sa)))
                                (setq 
                                        a (/ ia (1+ q))
                                        i 1
                                )
                                (repeat q
                                        (entmake 
                                                (list 
                                                        (cons 0 "LINE")
                                                        (cons 62 1)
                                                        (cons 10 vp)
                                                        (cons 11 (polar vp (+ sa (* a i)) (distance vp p1)))
                                                )
                                        )
                                        (setq i (1+ i))
                                )
                                (entmod ed1)
                                (entmod ed2) 
                        )
                );end_cond
        );end_progn
);end_if
(princ)
)
(defun gc:clockwise-p ( p1 p2 p3 )
(< (sin (- (angle p1 p3) (angle p1 p2))) -1e-14)
)
(defun select_e ( x msg / e sel)
(while (not e)
        (setq sel (entsel msg))
        (cond
                ((= nul sel) (princ "\n***No object selected. Please try again! ") )
                ((/= x (cdr (assoc 0 (entget (car sel))))) (princ "\n***Invalid choice! " ) )        
                ((= x (cdr (assoc 0 (entget (car sel))))) (setq e sel) )
                (t nil )
        )
)
)
(defun LM:intersections ( ob1 ob2 mod / lst rtn )
(setq lst (vlax-invoke ob1 'intersectwith ob2 mod))
(repeat (/ (length lst) 3)
        (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn)
                lst (cdddr lst)
        )
)
(reverse rtn)
)

;; Collinear-p  -  Lee Mac
;; Returns T if p1,p2,p3 are collinear
(defun LM:Collinear-p ( p1 p2 p3 )
(
        (lambda ( a b c )
                (or
                        (equal (+ a b) c 1e-
                        (equal (+ b c) a 1e-
                        (equal (+ c a) b 1e-
                )
        )
        (distance p1 p2) (distance p2 p3) (distance p1 p3)
)
)
;; Returns T if all point in a list are collinear
(defun LM:ListCollinear-p ( lst )
   (or (null (cddr lst))
       (and (LM:Collinear-p (car lst) (cadr lst) (caddr lst))
                (LM:ListCollinear-p (cdr lst))
        )
)
)

(setq lst '((4918.51 1699.6 0.0) (4467.33 1357.01 0.0) (4467.33 1357.01 0.0) (5283.96 1253.34 0.0)))
(LM:ListCollinear-p lst)