它具有相同的效果：
(T (progn (princ "\r/") (princ " ") (princ (itoa J)) (princ "/") (setq SPIN (princ (itoa N)) )
)
)
或者你想做：
(setq SPIN (strcat "\r/" (itoa J) "/" (itoa N)) )
(princ SPIN)
对它更优雅！
最后一个版本是：
; clear.lsp: Delete duplicate entities, tested only on polylines and circles.
; Core routine by Lee Mac 04-08-2013
; Output results by Luigi Calderone and Costinbos77 04-11-2013
;
(defun c:clear (/ old a b ent enx i lst s)
(setq xmin (car (getvar "EXTMIN"))
xmax (car (getvar "EXTMAX"))
ymin (car (cdr (getvar "EXTMIN")))
ymax (car (cdr (getvar "EXTMAX")))
old(ssget "_X")
N 10
J 0
)
(command "zoom" "e")
(prompt "\n")
(while (< J N)
(setq lst nil
s nil
pt1 (list xmin (+ ymin (/ (* (- ymax ymin) J) N)))
pt2 (list xmax (+ ymin (/ (* (- ymax ymin) (+ J 1)) N)))
J (+ J 1)
)
(if (setq s (ssget "_C" pt2 pt1))
(repeat (setq i (sslength s))
(foreach dx (entget (setq ent (ssname s (setq i (1- i)))))
(setq a (car dx)
b (cdr dx)
)
(cond
((or (= 'ename (type b)) (= a 5)))
((listp b)
(setq
enx (cons
(cons
a
(mapcar (function (lambda (x) (rtos x 2 )) b)
)
enx
)
)
)
((numberp b)
(setq enx (cons (cons a (rtos b 2 ) enx))
)
((setq enx (cons dx enx)))
)
)
(if (member enx lst)
(entdel ent)
(setq lst (cons enx lst))
)
(setq enx nil)
(cond (SPIN (setq SPIN NIL) (princ "\r\\"))
(t
(setq SPIN (strcat "\r/" (itoa J) "/" (itoa N)) )
(princ SPIN)
)
)
)
)
)
(if (setq trap old)
(prompt (strcat "\nNumber of elements before clearing- "
(itoa (sslength old))
)
)
(prompt (strcat "\nNumber of elements before clearing- 0"))
)
(if (setq trap (ssget "_X"))
(prompt (strcat "\nNumber of elements after clearing- "
(itoa (sslength (ssget "_X")))
)
)
(prompt (strcat "\nNumber of elements after clearing- 0"))
)
(if (setq trap (ssget "_X"))
(prompt (strcat "\nNumber of elements cleared- "
(itoa (- (sslength old) (sslength (ssget "_X"))))
)
)
(prompt (strcat "\nNumber of elements cleared- 0"))
)
(princ)
);end file
(prompt "\nLoaded new command CLEAR. ")
(princ)
你的方法是其他语言的典型（VBA等）。
不是更优雅，所以是正常的。
(princ (strcat "\r/" (itoa J) "/" (itoa N)) )
如果不需要旋转变量。
谢谢
最新版本：
; clear.lsp: Delete duplicate entities, tested on polylines, circles,
; mtexts texts, lines, splines, arcs, ellipses, ellipse arcs.
;
; Core routine by Lee Mac 04-08-2013
; Output results refined by Luigi Calderone and Costinbos77 04-11-2013
;
(defun c:clear (/ old a b ent enx i lst s)
(setq xmin (car (getvar "EXTMIN"))
xmax (car (getvar "EXTMAX"))
ymin (car (cdr (getvar "EXTMIN")))
ymax (car (cdr (getvar "EXTMAX")))
old(ssget "_X")
N 10
J 0
)
(command "zoom" "e")
(prompt "\n")
(while (< J N)
(setq lst nil
s nil
pt1 (list xmin (+ ymin (/ (* (- ymax ymin) J) N)))
pt2 (list xmax (+ ymin (/ (* (- ymax ymin) (+ J 1)) N)))
J (+ J 1)
)
(if (setq s (ssget "_C" pt2 pt1))
(repeat (setq i (sslength s))
(foreach dx (entget (setq ent (ssname s (setq i (1- i)))))
(setq a (car dx)
b (cdr dx)
)
(cond
((or (= 'ename (type b)) (= a 5)))
((listp b)
(setq
enx (cons
(cons
a
(mapcar (function (lambda (x) (rtos x 2 )) b)
)
enx
)
)
)
((numberp b)
(setq enx (cons (cons a (rtos b 2 ) enx))
)
((setq enx (cons dx enx)))
)
)
(if (member enx lst)
(entdel ent)
(setq lst (cons enx lst))
)
(setq enx nil)
(princ "\r\\")
(princ (strcat "\r/" (itoa J) "/" (itoa N)) )
)
)
)
(if (setq trap old)
(prompt (strcat "\nNumber of elements before clearing- "
(itoa (sslength old))
)
)
(prompt (strcat "\nNumber of elements before clearing- 0"))
)
(if (setq trap (ssget "_X"))
(prompt (strcat "\nNumber of elements after clearing- "
(itoa (sslength (ssget "_X")))
)
)
(prompt (strcat "\nNumber of elements after clearing- 0"))
)
(if (setq trap (ssget "_X"))
(prompt (strcat "\nNumber of elements cleared- "
(itoa (- (sslength old) (sslength (ssget "_X"))))
)
)
(prompt (strcat "\nNumber of elements cleared- 0"))
)
(princ)
);end file
(prompt "\nLoaded new command CLEAR. ")
(princ)
哦，不！
有点不对劲！
例程并没有在第一步清除所有重复项
问题不在核心例程中，而是在选择代码中。。。
有什么提示吗？ 我写的程序，删除所有重复的？ 可能是的，但它太慢了，速度是我唯一需要的，因为我有另一个例程可以工作，但我必须将其应用于大文件。
经过测试，似乎问题出在李的日常生活中。它工作得更快，但需要两到三次尝试。
我在附带的测试文件中测试了它。
谢谢
杜普雷姆。图纸 吉，我想我解决了。
的想法10个扇区中的除数将我带到了另一个分区，在实体类型之后。
对于n个项目，需要进行nx（n-1）/2比较。因此，对于7个项目（4个圆和3条线），需要7x6/2=21个对象比较。
但如果对实体组进行比较：
4x3/2+3x2/2=6+3=9个对象的比较，因此提高了处理速度。
(defun C:CLEARsA () ; 21 . 04 . 2013 .
(setq psj (getpoint "\n DelineatesProcessedArea !\n SelecttheBottom - LeftCorner:<Pick>:")texte ""
pds (getcorner psj "\n Selectthe Top - RightCorner:<Pick>:")slsel 0sk 0) ;_ end of setq
(foreach el '("ARC" "CIRCLE" "ELLIPSE" "INSERT" "LINE" "POLYLINE" "REGION" "SPLINE"
"TABLE" "MTEXT" "TEXT")
(princ (strcat "\n ObjectTYPEtoChecked:" el ";"))
(if (setq k 0sel (ssget "_W" psj pds (list (cons 0 el)) ) ) ;_ end of setq
(progn
(setq lsel (sslength sel)slsel (+ lsel slsel)i 0) ;_ end of setq
(princ (strcat "\n SelectedItems:" (itoa lsel) ";"))
(while (< i lsel)
(princ (strcat "\n CompareObject:" (itoa i) ";"))
(setq lobi (entget (ssname sel i))lobii (member (assoc 100 lobi) lobi)j (1+ i) ) ;_ end of setq
(while (< j lsel)
(setq nmoj (ssname sel j)lobj (entget nmoj)lobjj (member (assoc 100 lobj) lobj) ) ;_ end of setq
(if (equal lobii lobjj 0.000001)
(progn (command "zoom" "o" nmoj "")
(setq sel (ssdel nmoj sel)k (1+ k) ) ;_ end of setq
(princ (strcat "\n DeleteObjectNamber:" (itoa j) "from" (itoa lsel) "=" (itoa k) ";"))
(setq lsel (1- lsel) ) ;_ end of setq
(entdel nmoj) ;(alert (strcat "S-aStersObiectul:" (itoa k) ";" ))
) ;_ end of prog then
(setq j (1+ j)) ;_ end of setq
) ;_ end of if
) ;_ end of wh j
(setq i (1+ i)) ;_ end of setq
) ;_ end of wh i
) ;_ end of prog then
(setq lsel 0) ;_ end of setq
) ;_ end of if sel
(setq texte (strcat texte "\n Type:" el "=" (itoa lsel) ": Deleted:" (itoa k) ";" )sk (+ k sk)) ;_ end of setq
) ;_ end of f
(setq texte (strcat "\n\n SelectedItems:" (itoa slsel) ";" texte "\n DeletedObjects:" (itoa sk) ".")) ;_ end of
(princ texte) (textscr) (princ)
) ;_ end of defun
这很好，可以为大型图形划分扇区，否则扇区将很小，如果对象大于一个扇区，则一个对象位于多个扇区中，并增加处理时间。
可能需要添加和其他类型的实体。 我在星期五的邮件中在附件中尝试了你的例行程序，这并不过分：需要几个步骤来删除所有重复项，与Lee例行程序相比，它仍然没有那么快。
李，Costinbos77，
我发现这两个例程并没有彻底清除区域。
页:
1
[2]