删除图形上多余节点（同一直线上的多余节点及重复的节点）
多谢多位论坛高手的指导，慢慢才把这个功能给磨出来。小弟是个初学者，可能写的不够简洁，希望大家给点意见，看看可不可以简化。代码中有参考greatlmy 楼主，在http://bbs.mjtd.com/forum.php?mod=viewthread&tid=101906&fromuid=202795发的表处理函数。先说声谢谢了。(defun c:sd(/ om ss l_length i j n mm z data new_list last_list m_list en en_data old_pt_num f_list b_list pt1 pt2 pt_1 pt_2 pt_3
pt_num ang1 ang2 ang_d new_en_data new_pt_num)
(SETVAR "CMDECHO" 0)
(setq om (getvar "osmode")) ;取得对象捕捉的位码
(setvar "osmode" 0) ;关掉对象捕捉
(setq ss (ssget'((0 . "LWPOLYLINE"))));选择多个对象
(setq l_length 0)
(repeat (sslength ss)
(setq i 0
j 0
n 0
z 0
mm 0
data (list '(0 0))
new_list (list '(0 0))
last_list (list '(0 0))
m_list (list '(0 0))
)
(setq en (ssname ss l_length));获取第“l_length”个对象的对象名
(setq en_data (entget en));获取对象列表
(setq old_pt_num (assoc 90 en_data))
(if (> (cdr old_pt_num) 2)
(progn
(setq b_list (list(car (reverse en_data))));获取对象数据中最后一个列表数据（群码 210）
;;;获取新的列表格式为每个节点坐标及40、41、42群码为一个列表，与其他节点的列表合为一个列表
(while (/= (nth j en_data) nil)
(if (=(car(nth j en_data)) 10)
(progn
(setq data (append (list(list (nth j en_data) (nth (+ j 1) en_data) (nth (+ j 2) en_data) (nth (+ j 3) en_data))) data))
(setq z (+ z 1))
(if (= z 1)
(setq f_list (carnth j en_data));获取对象数据中第一个节点坐标前的列表数据
);end if
);end progn
);end if
(setq j (+ j 1))
);end while
(setq data (cdr(reverse data)))
;;;判断两点是否相同，是则将相同点的列表删除
(while (/= (nth i data) nil)
(setq pt1(cdr (car (nth i data))))
(if (/= (nth (+ i 1) data) nil)
(setq pt2(cdr (car (nth (+ i 1) data))))
(setq pt2(cdr (car (nth 0 data))))
);end if
(if (or (>= (distance pt1 pt2) 0.0001) (/= (cdr (car (reverse (nth i data )))) 0 ))
(setq new_list (append (list (nth i data )) new_list))
);end if
(setq i (+ i 1))
);end while
(setq new_list (cdr(reverse new_list)))
;;;删除同一条线上的点
(while (/= (nth n new_list) nil)
(setq pt_1 (cdr (car (nth n new_list))))
(if (/= (nth (+ n 1) new_list) nil)
(setq pt_2 (cdr (car (nth (+ n 1) new_list))))
(setq pt_2 (cdr (car (nth 0 new_list))))
);end if
(if (/= (nth (+ n 2) new_list) nil)
(setq pt_3 (cdr (car (nth (+ n 2) new_list))))
(if (/= (nth (+ n 1) new_list) nil)
(setq pt_3 (cdr (car (nth 0 new_list))))
(setq pt_3 (cdr (car (nth 1 new_list))))
);end if
);end if
(setq ang1 (angle pt_2 pt_1))
(setq ang2 (angle pt_2 pt_3))
(setq ang_d (- ang2 ang1))
(if (and (>= (abs ang_d) 0.001) (>= (abs (- (abs ang_d) pi)) 0.001))
(if (/= (nth (+ n 1) new_list) nil)
(setq last_list (append (list (nth (+ n 1) new_list)) last_list))
(setq last_list (append (list (nth 0 new_list)) last_list))
);end if
);end if
(setq n (+ n 1))
);end while
(setq last_list (cdr(reverse last_list)))
(setq last_list (append (list(car (reverse last_list))) (reverse (cdr (reverse last_list)))));获得最终节点列表
(setq pt_num (length last_list));获取最后节点坐标的个数
;;;将各节点与40、41、42合成的列表分开并与其他节点列表合为统一个列表，格式为对象数据的列表格式
(while (/= (nth mm last_list) nil)
(setq nn 0)
(while (/= (nth nn (nth mm last_list)) nil)
(setq m_list (append (list(nth nn (nth mm last_list))) m_list))
(setq nn (+ nn 1))
);end while
(setq mm (+ mm 1))
);end while
(setq m_list (cdr(reverse m_list)))
;;;对象更新
(setq new_en_data (append f_list m_list b_list))
(setq new_pt_num (cons 90 pt_num))
(setq new_en_data (subst new_pt_num old_pt_num new_en_data))
(entmod new_en_data)
(setq l_length (+ l_length 1))
);end progn
);end if
);end repeat
(setvar "osmode" om)
(alert "多余节点删除完毕！")
)
(defun carnth (m l)
; 表取头,保留表L前面I-1个元素，函数返回新表
(if (= m (length l))
l
(progn
(setq l (reverse l)
m (- (length l) m 1)
l (cdrnth m l)
)
(reverse l)
)
)
)
(defun cdrnth (m l)
; 表取尾,去除表L后面I个元素，函数返回新表
(repeat (1+ m) (setq l (cdr l)))
)
这功能好，经常软件生成的剪力墙是一段段的，连成线后又是很多多余的节点，这个刚好适用，谢谢分享 很给力，只是运行是捕捉会自动关调，能不能在调试下 如果是一条直线的多义线，就删除图形了，出错了 能上个图更好
试试看看！！！ 能不能改成缓和曲线的多余节点 顶你了楼主，非常好用，只是感觉"多余节点删除完毕"这个提示能否只在命令行显示即可，那样就更好了 lingduwx 发表于 2013-12-19 10:02 static/image/common/back.gif
顶你了楼主，非常好用，只是感觉"多余节点删除完毕"这个提示能否只在命令行显示即可，那样就更好了
你可以自行将后面那句：(alert "多余节点删除完毕！")删除，换成princ格式的提示就行了。看个人习惯了
不错，顶了！ 我来看MM的 发表于 2013-12-19 13:20 static/image/common/back.gif
你可以自行将后面那句：(alert "多余节点删除完毕！")删除，换成princ格式的提示就行了。看个人习惯了
...
谢谢，搞定了 这个很好用。感谢。但对于对于单段有多余点PLINE线没处理结果删除线了。 當他是練習吧
直接用overkill就可以了