cad图形复制平移与原图重叠了，求大神们帮忙想想处理方式，图大我发一部分上来
cad图形整体复制平移了，造成与原图重叠严重，求大神帮忙，图大，我弄一小块给大家看下，求帮忙！！！ET工具overkill
论坛里有消重工具，可以搜索一下 感谢，overkill处理不了，我看看其他消重能不能处理这种重复 高版本有CAD删重复功能的，超级强大。 路过，学习了 本帖最后由 Gu_xl 于 2017-10-17 14:48 编辑
;; 删除重复移动对象 By Gu_xl 2017.10.17
(defun C:DUMPENT (/ BLOCKS DXF41DXF411 DXF42DXF421 DXF43
DXF431 DXF50 DXF501 DXF7 DXF71E2 EL
EN ENAME I K LEN LEN1 LINES
N NAME NAME1NN P0 P1 POLYS
PP0 PP1 SS TEXTSVEC VEC1 VEC2
)
(if (setq ss (ssget))
(progn
(setq nn 0)
(if (and
(setq p0 (getpoint "\n基准点:"))
(setq p1 (getpoint "\n平移点:"))
)
(progn
(setq vec (mapcar '- p1 p0))
(setq lines nil
polys nil
blocks nil
texts nil
)
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(setq el (entget en)
ename (cdr (assoc 0 el))
)
(cond
((= "LINE" ename) (setq lines (cons en lines)))
((or (WCMATCH ename "*POLYLINE") (= "ARC" ename))
(setq polys (cons en polys))
)
((= "INSERT" ename) (setq blocks (cons en blocks)))
((WCMATCH ename "*TEXT") (setq texts (cons en texts)))
)
)
(if lines
(progn
(setq i 0)
(foreach e1 lines
(if (not (vlax-erased-p e1))
(progn
(setq k 0)
(setq p0 (vlax-curve-getStartPoint e1))
(setq pp0 (vlax-curve-getEndPoint e1))
(while (< k (length lines))
(setq e2 (nth k lines))
(setq p1 (vlax-curve-getStartPoint e2))
(setq vec1 (mapcar '- p1 p0))
(setq pp1 (vlax-curve-getEndPoint e2))
(setq vec2 (mapcar '- pp1 pp0))
(if (and
(equal vec vec1 1e-3)
(equal vec vec2 1e-3)
)
(progn
(entdel e2)
(setq nn (1+ nn))
(setq lines (vl-remove e2 lines))
)
(progn
(setq k (1+ k))
)
)
)
)
)
)
)
)
(if polys
(progn
(setq i 0)
(foreach e1 polys
(if (not (vlax-erased-p e1))
(progn
(setq k 0)
(setq p0 (vlax-curve-getStartPoint e1))
(setq pp0 (vlax-curve-getEndPoint e1))
(setq len (vlax-curve-getDistAtParam
e1
(vlax-curve-getEndParam e1)
)
)
(while (< k (length polys))
(setq e2 (nth k polys))
(setq p1 (vlax-curve-getStartPoint e2))
(setq vec1 (mapcar '- p1 p0))
(setq pp1 (vlax-curve-getEndPoint e2))
(setq vec2 (mapcar '- pp1 pp0))
(setq len1 (vlax-curve-getDistAtParam
e2
(vlax-curve-getEndParam e2)
)
)
(if (and
(equal vec vec1 1e-3)
(equal vec vec2 1e-3)
(equal len len1 1e-3)
)
(progn
(entdel e2)
(setq nn (1+ nn))
(setq polys (vl-remove e2 polys))
)
(progn
(setq k (1+ k))
)
)
)
)
)
)
)
)
(if blocks
(progn
(setq i 0)
(foreach e1 blocks
(if (not (vlax-erased-p e1))
(progn
(setq k0
el (entget e1)
)
(setq p0 (cdr (assoc 10 el))
name (cdr (assoc 2 el))
dxf41 (cdr (assoc 41 el))
dxf42 (cdr (assoc 42 el))
dxf43 (cdr (assoc 43 el))
dxf50 (cdr (assoc 50 el))
)
(while (< k (length blocks))
(setq e2 (nth k blocks)
el (entget e2)
)
(setq p1 (cdr (assoc 10 el))
name1(cdr (assoc 2 el))
dxf411 (cdr (assoc 41 el))
dxf421 (cdr (assoc 42 el))
dxf431 (cdr (assoc 43 el))
dxf501 (cdr (assoc 50 el))
)
(setq vec1 (mapcar '- p1 p0))
(if (and
(equal vec vec1 1e-3)
(= name name1)
(equal dxf41 dxf411 1e-3)
(equal dxf42 dxf421 1e-3)
(equal dxf43 dxf431 1e-3)
(equal dxf50 dxf501 1e-3)
)
(progn
(entdel e2)
(setq nn (1+ nn))
(setq blocks (vl-remove e2 blocks))
)
(progn
(setq k (1+ k))
)
)
)
)
)
)
)
)
(if texts
(progn
(setq i 0)
(foreach e1 texts
(if (not (vlax-erased-p e1))
(progn
(setq k0
el (entget e1)
)
(setq p0 (cdr (assoc 10 el))
name (cdr (assoc 1 el))
dxf7 (cdr (assoc 7 el))
dxf50 (cdr (assoc 50 el))
)
(while (< k (length texts))
(setq e2 (nth k texts)
el (entget e2)
)
(setq p1 (cdr (assoc 10 el))
name1(cdr (assoc 1 el))
dxf71(cdr (assoc 7 el))
dxf501 (cdr (assoc 50 el))
)
(setq vec1 (mapcar '- p1 p0))
(if (and
(equal vec vec1 1e-3)
(= name name1)
(= dxf7 dxf71)
(equal dxf50 dxf501 1e-3)
)
(progn
(entdel e2)
(setq nn (1+ nn))
(setq texts (vl-remove e2 texts))
)
(progn
(setq k (1+ k))
)
)
)
)
)
)
)
)
)
)
)
)
(princ (strcat "\n共删除了 " (itoa nn) " 个对象..."))
(princ)
) 感谢 G版 分享程序!!!! 效果棒，只是图大点速度稍微慢。对尺寸，填充那些不行。最好是常用物体都支持 本帖最后由 Gu_xl 于 2017-10-18 11:40 编辑
lz123456 发表于 2017-10-17 20:41
效果棒，只是图大点速度稍微慢。对尺寸，填充那些不行。最好是常用物体都支持
代码只是顺手而写，其他对象根据代码类似添加处理即可！效率没办法改进，可以在使用时一次性少选一些对象即可提高速度！如果说改成arx来实现，那效率绝对岗岗的！有空我会写到XLRX中去！ 感谢 G版 分享程序!!!!
页:
[1]
2