消除重复的直线、圆弧
对直线的消除重线算法，会将直线转换为了f(x)=kx+b的形式；对于由多个圆心及半径相同的圆弧而组成的圆形，消除重线时会出现错误的效果（正确的应该是组成一个完整的圆），Express中的Overkill命令也有这个问题，这里给出的不是完善的源码，已完善的程序已集成在中。;;; *****消除重线 程序开始*****
(defun C:T1 ()
(princ
"\n★功能：删除重复的直线、圆弧.\n提示：只可删除在相同图层的重线！"
)
(setvar "cmdecho" 0)
(setvar "plinewid" 0)
(command "undo" "be")
(vl-load-com)
(setq ss (ssget '((0 . "ARC,LINE"))))
(princ "\n--->程序进行中，请稍后...\n")
(if ss
(hbzhx ss)
(progn (princ "\n提示：未选取对象.") (exit))
)
(command "undo" "e")
(alert "\n提示：消除重线完成！\n")
(princ)
)
(defun cs_pross (to i / CS_TEXT MYI)
(setq cs_text ">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>")
(setq myi (fix (/ (* (strlen cs_text) i) to))
cs_text (substr cs_text 1 myi)
)
(grtext -2 cs_text)
)
(defun hbzhx (ss /)
(grtext -2 "正在整理数据")
(initget 4)
(if (not (setq jd (getreal "\n输入精度要求：\n")))
(setq jd 1e-4)
)
(setq i 0
line_list '()
arc_list '()
)
(repeat (sslength ss)
(setq ent (ssname ss i)
i (1+ i)
)
(setq obj (vlax-ename->vla-object ent))
(if (> (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
jd
)
(if (= "LINE" (cdr (assoc 0 (entget ent))))
(setq line_list (cons (line_data ent) line_list))
(setq arc_list (cons (arc_data ent) arc_list))
)
)
)
(setq line_list
(vl-sort
line_list
'(lambda (e1 e2)
(if (equal (car e1) (car e2) jd)
(if (equal (cadr e1) (cadr e2) jd)
(if (equal (car (caddr e1)) (car (caddr e2)) jd)
( (length line_list) 0)
(setq xuhao (1+ xuhao))
(cs_pross zongshu xuhao)
(setq line_a (car line_list)
line_list (cdr line_list)
biaoji t
k (car line_a)
b (cadr line_a)
p1 (caddr line_a)
p2 (cadddr line_a)
ent (last line_a)
lay (cdr (assoc 8 (entget ent)))
)
(while (and biaoji
(> (length line_list) 0)
)
(setq line_b (car line_list))
(cond
((and (equal k (car line_b) jd)
(equal b (cadr line_b) jd)
(= lay (cdr (assoc 8 (entget (last line_b)))))
)
(setq p3 (caddr line_b)
p4 (cadddr line_b)
p5 (vl-sort (list p1 p2 p3 p4)
'(lambda (e1 e2)
(if (equal (car e1) (car e2) jd)
( (length arc_list) 0)
(setq xuhao (1+ xuhao))
(cs_pross zongshu xuhao)
(setq arc_a (car arc_list)
arc_list (cdr arc_list)
biaoji t
bj (car arc_a)
pc (list (cadr arc_a) (caddr arc_a))
sangl (cadddr arc_a)
eangl (nth 4 arc_a)
ent (last arc_a)
lay (cdr (assoc 8 (entget ent)))
)
(while (and biaoji
(> (length arc_list) 0)
)
(setq arc_b (car arc_list)
)
(cond
((and (equal bj (car arc_b) jd)
(equal pc (list (cadr arc_b) (caddr arc_b)) jd)
(= lay (cdr (assoc 8 (entget (last arc_b)))))
)
(setq sangl1 (cadddr arc_b)
eangl1 (nth 4 arc_b)
p5 (vl-sort (list sangl eangl sangl1 eangl1)
'(lambda (e1 e2)
(vla-object ent)
p1 (vlax-curve-getstartpoint obj)
p2 (vlax-curve-getendpoint obj)
)
(if (equal (car p1) (car p2) jd)
(setq k nil
b (car p1)
)
(setq k (/ (- (cadr p2) (cadr p1))
(- (car p2) (car p1))
)
b (- (cadr p1) (* (car p1) k))
)
)
(setq p2 (vl-sort (list p1 p2)
'(lambda (e1 e2)
(if (equal (car e1) (car e2) jd)
(演示
这个有个问题，能否先把短线直接删除，而不是用点坐标判断后再附值到一根线中？ 挺好用得，大佬能帮忙改下下吗？不管是不是同一个图层都能除去重复的。谢谢您 ;; 直线共线合并是不是也算消重？
高级顶顶高级顶顶 感谢，，，学习学习了
谢谢楼主分享 我也编了一个这样的程序，只是只限于直线，这个程序更牛 学习一下 111 谢谢楼主分享
页:
[1]
2