可以做额外的东西
你好此例程删除属于相同组名的重复块。
那太好了，但我想在他删除之前先看看哪一个是重复的！
事实上，他只说了“删除x块”，但你不知道在计划的哪里。
因此，在发出命令后，可以执行以下操作：
1） 通过选择，可以看到所有重复块的位置
2） 然后删除
非常感谢。 您可能在这个命令（vla delete objc）之前放了一些东西，比如未测试的（getstring“press enter”）。 我只是复制/粘贴。。。我不懂lisp代码。
这就是我寻求帮助的原因。 试试这个程序，让你知道事情进展如何。
(defun c:Test (/ b nm bks ss i sn e l lst g n)
;;------------------------------------;;
;; Tharwat 20.05.2015 ;;
;; Highligh Duplicated blocks ;;
;;------------------------------------;;
(while (setq b (tblnext "BLOCK" (not b)))
(if (and (not (assoc 1 b))
(not (wcmatch (setq nm (cdr (assoc 2 b))) "*|*"))
)
(setq bks (cons nm bks))
)
)
(princ
"\nSelect Blocks to highligh duplicates in position :"
)
(if (setq g(ssadd)
ss (ssget
"_:L"
(list
'(0 . "INSERT")
(cons
2
(apply 'strcat (mapcar '(lambda (u) (strcat u ",")) bks))
)
)
)
)
(progn
(repeat (setq i (sslength ss))
(setq sn (ssname ss (setq i (1- i)))
e(entget sn)
l(cons (list sn (cdr (assoc 10 e))) l)
)
)
(mapcar '(lambda (p)
(if (vl-some '(lambda (q)
(and
(equal (cadr p) (cadr q) 1e-4)
(not (eq (car p) (car q)))
(not (member (cadr q) lst))
)
)
l
)
(progn
(setq lst (cons (cadr p) lst))
(ssadd (car p) g)
)
)
)
l
)
(if (< 0 (setq n (sslength g)))
(princ (strcat "\nNumber of Duplicated Blocks found [ "
(itoa n)
" ] :"
)
)
(princ "\nNo duplicate Blocks found !")
)
)
)
(sssetfirst nil g)
(princ)
)
塔尔瓦特。。。。再一次
此lisp还会选择一个在我的平面中不重复的外部参照。
是否可以仅对块使用此选项，而不使用外部参照选项？
谢谢 一次又一次
以上代码已更新。 再一次。。。太棒了！！！
下次见
非常感谢。
不客气。
页:
[1]