Squirltech 发表于 2022-7-5 16:53:46

我们这里的一位开发人员使用制作了一个平分线工具。网它工作得很好,但你必须按一定的顺序选线。

tombu 发表于 2022-7-5 16:56:56

代码不错,我换了35行
(setq a (getkword (strcat "\n Bisector Type - Angula /Linear <" ad ">:   ")))至
(setq a (getkword (strcat "\n Bisector Type - [Angula/Linear] <" ad ">:   ")))
这样我就可以用鼠标选择了。
那是守门员,谢谢

David Bethel 发表于 2022-7-5 17:00:32

 
谢谢
 
我怀疑我会用它,但它很有趣
 
我不知道[]是什么时候被引入鼠标选项的。它在我通常使用的版本中不可用。
 
很高兴你发现它很有用-大卫

77077 发表于 2022-7-5 17:03:28

 
很好的习惯,大卫
 
我测试发现,不能用于Pline,
如果2条线没有交点,也不能画对分线。
 
我有个主意。可以计算交点并绘制对分吗?
李函数

(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)
)

David Bethel 发表于 2022-7-5 17:07:05

 
谢谢
 
 
它实际上并不适用于多段线。太多的障碍物和错误陷阱。
 
平行线应始终在角度模式下失效
 
对于无交点(角度),(inters)函数可以找到交点,但:
[列表]
[*]如果这两条线形成一个X怎么办
如何确定四个方向/角度中的哪一个要平分
[/列表]
 
我相信如果出现这样的情况,还会有很多其他问题。
 
-大卫

tombu 发表于 2022-7-5 17:08:48

如果有人想修改David的多段线代码,这可能是一个很好的起点:http://gilecad.azurewebsites.net/LISP/PolySegments.lsp
几年前,我创建了一个lisp,用于标记直线或多段线线段,该线段复制了多段线,分解了多段线,选择了具有相同点的直线或圆弧段,用于选择多段线并保存其elist,然后删除所有新创建的线段。它也可以是一个起点,与具有用于显示直线和圆弧特征的属性的块一起附着。
Dim_弧。图纸
Dim_线。图纸
Line_标签。lsp

David Bethel 发表于 2022-7-5 17:10:35

Post 10更新了一些错误陷阱

77077 发表于 2022-7-5 17:14:07

 
嗨tombu
此例程可以支持pline。

;;;;;;;;;;;;;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-safearrayvlax-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-safearrayvlax-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<->11s1)
                        (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<->11s2)
                        (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)))
                        (setqfglst nil)
                        (fgb dxf_e1)
                        (setq dxf10_lst fglst n 0)
                        (if (> (length nentsel_e1) 2)
                                (progn
                                        (setq dxf10_lst(mapcar (function(lambda(x)(transx (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)))
                        (setqfglst nil)
                        (fgb dxf_e2)
                        (setq dxf10_lst fglst n 0)
                        (if (> (length nentsel_e2) 2)
                                (progn
                                        (setq dxf10_lst(mapcar (function(lambda(x)(transx (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<->11s2)
                                        (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
                                (EQUALvla_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-copyvla_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 ))
                                                )
                                                (setqinters_angle (- myline1_angmyline2_ang))
                                                (progn
                                                        (if (< myline1_ang myline2_ang)
                                                                (setqinters_angle (- myline1_ang(- myline2_ang (* 2 pi))))
                                                                (setqinters_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_anglepi )
                                                                        (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-copymyline))
                                (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
                (setqdxf10 (nth n lst))
                (setq fglst1 (append fglst1 (list dxf10 )))
                (setq n (1+ n))
        )
        (setq fglst (appendfglst (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))
)


 
但仍有一些缺陷,例如:无交点(角度)

77077 发表于 2022-7-5 17:19:22

 
嗨,大卫,
在以下两种情况下仍然无法绘制平分线

 
我修改了你的代码。请不要介意。


(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)
)

77077 发表于 2022-7-5 17:21:02

可以添加检查共线功能,如果共线,则退出。
 
@李·麦克
 
尊敬的李:
我使用LM:listcolliner-p函数,发现了一个问题。为什么?

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

为什么返回“T”?
 
列表中的四个元素是两条线的顶点。
必须使用LM:unique删除重复元素?
页: 1 [2]
查看完整版本: 绘制平分线