自己编的直线交叉打断，line线正常，Pline线不正常，请高手指教！

suqing

(vl-load-com)
(setq $tom_dis 3.0 )
;;;=============================================================================================
;;;获取单选line线、pl线  的选择点，两端点坐标，及线角度值，线类型，并返回列表 子程序            
;;;=============================================================================================
(defun TT-get-ptang (ent1 / x n ok ent0 pt0 pt1 pt2 pt3 pt4 pt5 ang type0 plw1 lay)
;;;pt0 为pl线端点列表 pt1为选择点 pt4为选择点与线的垂足点 pt5为就近2端点列表
(setq pt1 (cadr ent1) pt4 (reverse(cdr(reverse(osnap pt1 "MID")))) )
(setq ent0 (entget (car ent1)))
(setq type0 (cdr (assoc 0 ent0)))
(if (equal type0 "LWPOLYLINE")
(progn
  (foreach x ent0
   (if (= (car x) 10) (setq pt0 (cons (cdr x) pt0)) )
  );end foreach由此取得pl线所有端点的倒序列表，需反转
  (setq pt0 (reverse pt0) plw1 (cdr (assoc 41 ent0)) lay (cdr (assoc 8 ent0)) n 0)
  
  (while  (not ok)
    (setq pt2  (nth n pt0)
   pt3 (nth (1+ n) pt0)
   ang (angle pt2 pt3) ;为弧度值
   n (1+ n)
    )
    (if (or (= ang (angle pt2 pt4)) (= ang (angle pt3 pt4))) (setq ok t pt5 (list pt2 pt3)) )
  )
);progn
);if
  
(if (equal type0 "LINE")
(setq pt2 (reverse (cdr (reverse (cdr (assoc 10 ent0)))))
pt3 (reverse (cdr (reverse (cdr (assoc 11 ent0)))))
pt5 (list pt2 pt3)
plw1 (getvar "PLINEWID")
ang (angle pt2 pt3) ;为弧度值
lay (cdr (assoc 8 ent0))
)
);if
(setq ang (angle pt2 pt3));求角度
(setq pt4 (inters pt2 pt3 pt1 (polar pt1 (+ ang (/ pi 2)) 1) nil));取得选择点与线的垂足点
;;;  (if (zerop plw1) (setq plw1 nil) )
  (cons (append (list type0 pt1 pt4 ang lay plw1) pt5) pt0)
);end sub

• ;;============================================================
  ;;交点打断，按线-线选择，打断
  ;;单线打断
  (defun c:c4 (/ loop msg dis  dis1  s1 bl1 ent0
  ent1  ent1_pt1  ent1_pt2  
  ent2  ent2_pt1  ent2_pt2  ent2_ang
  ent_bk ent_intpt  ent2_bkpt1   ent2_bkpt2 )
    (acet-error-init (list(list "CMDECHO" 0 "OSNAPCOORD"  2 "OSMODE" 0) t ))
    (setq bl1 (getvar "HPSCALE") dis1 (/ (* $tom_dis bl1) 2) loop nil)
  (while (not loop)
     (setq msg (strcat "[打断长度(" (rtos $tom_dis 2 1) ")<X>]")
    ent0 (clh-entsel (strcat "\n选择打断线" msg ": ") "X" '((0 . "*POLYLINE,LINE")) "\n所选对像不符合要求！请重新选择：")
     )
  (if (not ent0)  (setq loop t))
  (cond
    ((= ent0 "X")
  (if (setq dis (getreal (strcat "\n设置打断长度<" (rtos $tom_dis 2 1) ">:")))
  (setq $tom_dis dis )
  )
  (setq dis1 (/ (* $tom_dis bl1) 2))
  );part1
  ((= (type ent0) 'list)
    (setq s1 (car ent0) ent2 (entget s1))
  
    (setq ent1 (entget (car (TT-entsel "\n选择参考线: " '((0 . "*POLYLINE,LINE")) ))) )
    (redraw s1 4)
     
    (if (eq (cdr (assoc 0 ent1)) "LWPOLYLINE")
     (setq ent1_pt1 (cdr (assoc 10 ent1))
     ent1_pt2 (cdr (assoc 10 (reverse ent1))))
    );if
    (if (eq (cdr (assoc 0 ent1)) "LINE")
     (setq ent1_pt1 (reverse (cdr (reverse (cdr (assoc 10 ent1)))))
     ent1_pt2 (reverse (cdr (reverse (cdr (assoc 11 ent1))))))
    );if
    (if (eq (cdr (assoc 0 ent2)) "LWPOLYLINE")
     (setq ent2_pt1 (cdr (assoc 10 ent2))
     ent2_pt2 (cdr (assoc 10 (reverse ent2))))
    );if
    (if (eq (cdr (assoc 0 ent2)) "LINE")
     (setq ent2_pt1 (reverse (cdr (reverse (cdr (assoc 10 ent2)))))
     ent2_pt2 (reverse (cdr (reverse (cdr (assoc 11 ent2))))))
    );if
    (setq ent2_ang (angle ent2_pt1 ent2_pt2))     
    (if (setq ent_intpt (inters ent1_pt1 ent1_pt2 ent2_pt1 ent2_pt2))
    (progn
    (setq ent2_bkpt1 (polar ent_intpt ent2_ang dis1))
    (setq ent2_bkpt2 (polar ent_intpt (+ pi ent2_ang) dis1))
    (setq ent_bk (list s1 ent2_bkpt1))
    (command "break" ent_bk ent2_bkpt2)
     );progn
    );if
  );part2
  );end cond
    
  );end while
    (acet-error-restore)
    (princ)
    );defun
  ;
  

引用了ET工具的错误处理，自己不会写，呵呵！

suqing

基本上都是在论坛里找的源码，自己学着改的，前后有半年了吧！也不知道都是用的谁的源码了，不好意思了！

suqing

没有高手指教下。

suqing

顶下，不沉底，求高手指教！