[弹指神通]：能用lisp编写删除同一文件中重复的块吗？

zwf9900 · 发表于 2008-7-9 21:09:52

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

*-*b 在实际工作中，经常会用到块，但有时用重复插入了，能用lisp编写删除同一文件中重复的块吗？只留一个就可以了！其余的删除

zxq0220 · 发表于 2008-7-11 20:43:44

[php]
;删除重复块晓东 zxq0220 2008.7.11
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget "X" '((0 . "INSERT")))) (progn
  (setq i 0 ess (list))
  (repeat (sslength ss)
(setq s1 (ssname ss i)
      ent (entget s1)
      ss1 (ssget "X" (list '(0 . "INSERT") (assoc 2 ent))))
(if (> (sslength ss1) 1) (setq ss1 (ssdel s1) ess (cons ss1 ess)))
(setq i (1+ i))
  )
  (setq i 0)
  (command ".erase")
  (repeat (length ess)
(command (nth i ess))
(setq i (1+ i))
  )
  (command "")
))
(setvar "CMDECHO" 1)
(princ)
)
[/php]

zwf9900 · 发表于 2008-9-28 09:30:06

谢谢楼主的程序，回家试试去！

yoyoho · 发表于 2008-10-5 05:32:02

楼主阿!
删除重复块测试不能运行阿!
麻烦楼主查看!

xyp1964 · 发表于 2008-10-12 09:04:01

[FONT=courier new];; 需要通用函数XYPLib.vlx的支持
(defun c:test ()
(CMDLA0)
(setq ss (ssget '((0 . "INSERT")))
lst '()
ss0 (ssadd)
i -1
)
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq bn (xyp-get-dxf 2 s1))
(if (member bn lst)
(setq ss0 (ssadd s1 ss0))
(setq lst (cons bn lst))
)
)
(if ss0
(command "erase" ss0 "")
)
(CMDLA1)
)[/FONT]

逐月飞鸿 · 发表于 2008-11-2 16:33:59

xyp1964 版主是一个高手

foride · 发表于 2008-11-5 08:57:20

最初由逐月飞鸿发布
[B]xyp1964 版主是一个高手 [/B]

可以帮助我也编个程序么，在另外一个（程序申请里），都这么长时间了，都没有人出手，哎*-*a

rthzg · 发表于 2008-12-11 18:05:10

最初由 danielwang321 发布
[B]看不东 [/B]

可以直接用就行哦！

谢谢斑竹！

账号		自动登录	找回密码
密码			立即注册

[弹指神通]：能用lisp编写删除同一文件中重复的块吗？

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子