I need ur help
Hey, guys,I need you guys' help!!!
How to develop an AutoLISP routine to finish this task.
there might be some duplicate entities (sometimes, more than two entities) in some layers, how to remove the "duplicated" entities to another new layer and leave only one entity in the original layer, any reply would be appreciated!!! (sorry I am writing in English) Actually Autocad has similar command---Overkill. This command can delete the duplicate entities. These are many topic about this issue in the forum. You can search it. Welcome. hey, buddy
thank u very much for ur reply, but my purpose is not to delete the duplicated entities, just cut them and paste them to a new layer. have any idea about this?
thank u very much 本帖最后由 作者 于 2004-5-27 10:38:16 编辑 <br /><br /> This is a program about delete duplicated circle,pl,line,spline, block.
Maybe you can get some hint from it. You can revise it to suit your need.
(defun C:DUP (/ F1 SLE SA CA TA LA LB ENTA EA TYPA A1 A2 A3 A4 SC<BR> LTEST TES<BR> )<BR> (setvar "cmdecho" 0)<BR> (setq F1 NIL<BR> F1 0<BR> )<BR> <BR> ;; Start<BR> (or :GCHOICE (setq :GCHOICE "Select"))<BR> (initget "Select All")<BR>;;; (setq SLE (getkword "\nSelect objects by <S>election set, <L>imits, or <E>ntire database: "))<BR> (setq SLE<BR> (getkword (strcat "\nType of selection <"<BR> :GCHOICE<BR> ">: "<BR> )<BR> )<BR> )<BR> (if (not SLE)<BR> (setq SLE :GCHOICE)<BR> (setq :GCHOICE SLE)<BR> )<BR> (cond<BR> ((= SLE "Select") (setq SA (ssget)))<BR> ((= SLE "Limits")<BR> (setq SA (ssget "c" (getvar "extmin") (getvar "extmax")))<BR> )<BR> ((= SLE "All") (setq SA (ssget "X")))<BR> )
(if (and SA (= (type SA) 'PICKSET) (not (zerop (sslength SA))))<BR> (progn<BR> (setq CA 0<BR> TA (sslength SA)<BR> LA NIL<BR> LB NIL<BR> )<BR> (while (< CA TA)<BR> (setq ENTA (ssname SA CA)<BR> EA (cdr (entget ENTA))<BR> TYPA (cdr (assoc 0 EA))<BR> )<BR> ;; (if (= typa "POLYLINE") (progn<BR> ;; (setq entb (entnext enta) ea (cdr (entget entb)))<BR> ;; ))<BR> <BR> ;; Updated for R14 & 2002<BR> ;; Start<BR> (setq A1 (assoc 5 EA))<BR> (setq A2 (cons 5 ""))<BR> (setq EA (subst A2 A1 EA))<BR> (if (wcmatch (getvar "ACADVER") "*15*")<BR> (progn<BR> (setq A3 (assoc 330 EA))<BR> (setq A4 (cons 330 ""))<BR> (setq EA (subst A4 A3 EA))<BR> )<BR> )
(setq LA (cons ENTA LA)<BR> LB (cons EA LB)<BR> CA (+ CA 1)<BR> )<BR> )<BR> (setq SC NIL<BR> SC (ssadd)<BR> LTEST LB<BR> )<BR> (setq CA 0)<BR> (setq TES (car LTEST)<BR> LTEST (cdr LTEST)<BR> TA NIL<BR> TA (length LTEST)<BR> )<BR> (while (/= TA 0)<BR> (if (member TES LTEST)<BR> (progn<BR> (setq SC (ssadd (nth CA LA) SC))<BR> (prompt "\nFound duplicate entity.")<BR> (setq F1 (+ F1 1))<BR> )<BR> )<BR> (setq CA (+ CA 1))<BR> (setq TES (car LTEST)<BR> LTEST (cdr LTEST)<BR> TA (length LTEST)<BR> )<BR> )<BR> (command "erase" SC "")<BR> (redraw)<BR> (prompt "\n")<BR> (prin1 F1)<BR> (prompt " duplicate entities erased.")<BR> )<BR> )<BR> (princ)<BR>)<BR>(prompt<BR> "\nType DUP to run. Delete duplicate entity routine."<BR>)<BR>(princ) Buddy(<A name=21739><FONT color=#000066><B>citykunan</B></FONT></A>), could I have ur email address, hope i didn't offend u. ，看不懂啊，该学习了，唉 对不起飞版主,bmn2k3v6在美国可能系统不能输中文。(明经已经飘洋过海了)
To bmn2k3v6: 其实你可以多问问明经的版主,他们都是一流的高手. <BR> meflying为人热心,编成的思路很独特.<BR> 龙龙仔版主,水平很高,他在台湾,英语一定也不错.<BR> alin贵宾,好像是香港的,英语很棒,经常用英语发帖.<BR> 他们一定会帮助你的.
咳,只有我lisp也不行,英语也不好,还需多多努力. <A name=21751><FONT color=#000066><B>meflying</B></FONT></A>, which aspect u didn't understand, u r awesome, admire u a lot. bmn是要将同一个层上重叠（类似原点拷贝的结果）的两个实体中的一个改到其它层。 ：） 這是個好點子
页:
[1]
2