重叠的线段，隐蔽的线段完全清除的LISP源代码

;;;本程序对于重叠的线段完全清除，对隐蔽的线段可以完全清除。
(defun enty (en / tyen)
(setq tyen (cdr (assoc 0 (entget en))))
)
;;;实体图元句柄
(defun enha (en / haen)
(setq haen (cdr (assoc 5 (entget en))))
)
;;;实体线型
(defun enlt (en / lten)
(setq lten (cdr (assoc 6 (entget en))))
;;;实体数据表没有线型
)
;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;直线的一元属性
;;;直线起点
(defun stli (en / spli)
(if (= (enty en) "LINE")
(setq spli (cdr (assoc 10 (entget en))))
)
)
;;;直线终点
(defun lied (en / edli)
(if (= (enty en) "LINE")
(setq edli (cdr (assoc 11 (entget en))))
)
)
(defun pxy (p) (list (car p) (cadr p)))
(defun online2 (enl pt / p1 p2)
(setq p1 (trans (en_val 10 enl) (en_val -1 enl) 1)
p2 (trans (en_val 11 enl) (en_val -1 enl) 1)
)
(setq p1 (pxy p1)
p2 (pxy p2)
pt (pxy pt)
)
(if (equal (distance p1 p2)
(+ (distance p1 pt) (distance pt p2))
0.1
)
t
nil
)
)
(defun sslninter (en / p1 p2 p3 p4 p5 p6 s1 ang plist)
(setq p1 (cdr (assoc 10 (entget en))))
(setq p2 (cdr (assoc 11 (entget en))))
(setq ang (angle p1 p2))
(setq p3 (polar p1 (+ ang (* pi 0.75)) 1.0))
(setq p4 (polar p1 (- ang (* pi 0.75)) 1.0))
(setq p5 (polar p2 (- ang (/ pi 4.0)) 1.0))
(setq p6 (polar p2 (+ ang (/ pi 4.0)) 1.0))
(setq plist (list p3 p4 p5 p6))
(setq s1 (ssget "CP" plist))
;;(setq s1 (ssget "F" plist ))
(if (and s1 (ssmemb en s1))
(setq s1 (ssdel en s1))
)
(if (and s1 (= (sslength s1) 0))
(setq s1 (ssadd))
s1
)
)

(defun ll_gx (en1 en2 / e e1 tp)
(if (and (= (enty en1) "LINE")
(= (enty en2) "LINE")
(or (< (abs (- (liang en1) (liang en2))) 0.0001)
(and (< (abs (- (liang en1) (liang en2))) (+ pi 0.0001))
(> (abs (- (liang en1) (liang en2))) (- pi 0.0001))
)
)
)
(progn
(setq e (polar (stli en1) (+ (liang en1) (/ pi 3.0)) 1000))
(setq e1 (inters (stli en2) (lied en2) e (stli en1) nil))
(if (equal (stli en1) e1 0.001)
(setq tp "llgx")
(setq tp nil)
)
)
)
)






(defun del_overlaplines (/ i j num eni enj
enisp eniend enjsp enjend f1 lines
sj numsj
)
;;此处可以根据具体线形修改
(setq lines
(ssget "X" ’((0 . "LINE")))
)
(setq i 0)
(setq j 0)
(setq num (sslength lines))
(if (< num 1)
(princ "错误提示：线段数目少于一个 ")
)

(while (< i (sslength lines))

(setq eni (ssname lines i))
(setq sj (sslninter eni))
(setq j 0)

(repeat (sslength sj)


(setq enj (ssname sj j))
(setq f1 (ll_gx eni enj))
(setq enisp (stli eni))
(setq enjsp (stli enj))
(setq eniend (lied eni))
(setq enjend (lied enj))

(if (and
(= f1 "llgx")
(AND (= (NTH 0 enjsp) (NTH 0 enisp))
(= (NTH 1 enjsp) (NTH 1 enisp))
)
(AND (= (NTH 0 enjend) (NTH 0 eniend))
(= (NTH 1 enjend) (NTH 1 eniend))
)
)

(progn
(command "erase" eni "")
(setq i (- i 1))

(setq lines (ssdel eni lines))
)

(progn
(if (and
(= f1 "llgx")
(online2 enj enisp)
(online2 enj eniend)
)
(progn
(command "erase" eni "")

(setq lines (ssdel eni lines))
(setq i (- i 1))
)
)
)
)

(setq j (1+ j))


)
(setq i (1+ i))

)

)
(del_overlaplines)