[分享]册除重复线
<p>网上找的，东西不错，就是不够完善，斜线删除会误删，请高手修改。</p><p>(defun c:adk ()<br/>(graphscr)<br/>(setvar "cmdecho" 0)<br/>(command "pickbox" 3)<br/>(command "dim" "dimzin" 0 "e")<br/> (setq cen (getvar "viewctr"))<br/> (setq vpt1 (getvar "vsmin"))<br/> (setq vpt2 (getvar "vsmax"))<br/>(setq<br/> p (/ pi 2.0)<br/> g (+ pi p))<br/>(setq aa (ssget "c" vpt1 vpt2 ))<br/>(command "pickbox" 0)<br/> (setq zz 0)<br/> (setq ui 0)<br/> (setq ab (ssadd))<br/>(princ "\n 请稍候;正在去除......") <br/> (repeat (sslength aa)<br/> (setq aab (ssname aa ui))<br/> (setq bb (cdr (assoc 0 (entget aab))))<br/>(cond ((= bb "LINE")<br/>(setq qst (cdr (assoc 11 (entget aab))))<br/>(setq qed (cdr (assoc 10 (entget aab))))<br/>(setq qedq (cdr (assoc 210 (entget aab))))<br/>(setq ad (distance qst qed)<br/> dd (angle qst qed)<br/> de (angle qed qst)<br/>) <br/>;(cond ((> ad 4)<br/>(setq aj (/ ad 2.25))<br/>(setq aq (/ ad 3.0))<br/>(setq qxa (polar qst dd aj))<br/>(setq qxb (polar qst dd aq))<br/>(setq pt1 (list (car qxa)(cadr qxa)))<br/> (setq qaa (ssget "c" qxa qxb '((0 . "LINE"))))<br/>; (setq qaa (ssget '(4.4444 10.0)))<br/> (setq xuui 0)<br/> (setq qab (ssadd))<br/> (repeat (sslength qaa)<br/> (setq qaab (ssname qaa xuui))<br/> (setq qbb (cdr (assoc 0 (entget qaab))))<br/>(cond ((= qbb "LINE") <br/>(cond ((= xuui 0) <br/> (setq caab (ssname qaa xuui))<br/> (setq dqbb (cdr (assoc 0 (entget caab))))<br/>(cond ((= dqbb "LINE")<br/>(setq qst (cdr (assoc 11 (entget caab))))<br/>(setq qed (cdr (assoc 10 (entget caab))))<br/>(setq ad (distance qst qed)<br/> dd (angle qst qed)<br/> de (angle qed qst)<br/> hdd (angtos dd 0 2)<br/>)<br/>(setq a1 (car qst)<br/> a2 (cadr qst)<br/> a3 (car qed)<br/> a4 (cadr qed)<br/> ha1 (rtos a1 2 4)<br/> ha2 (rtos a2 2 4)<br/> ha3 (rtos a3 2 4)<br/> ha4 (rtos a4 2 4)<br/>)<br/>)))) <br/>(cond ((>= xuui 1)<br/> (setq baab (ssname qaa xuui))<br/> (setq bqbb (cdr (assoc 0 (entget baab))))<br/>(cond ((= bqbb "LINE") <br/>(setq aqst (cdr (assoc 11 (entget baab))))<br/>(setq aqed (cdr (assoc 10 (entget baab))))<br/>(setq aad (distance aqst aqed)<br/> add (angle aqst aqed)<br/> ade (angle aqed aqst)<br/> hadd (angtos add 0 2)<br/> hade (angtos ade 0 2)<br/>)<br/>(setq a5 (car aqst)<br/> a6 (cadr aqst)<br/> a7 (car aqed)<br/> a8 (cadr aqed)<br/> ha5 (rtos a5 2 4)<br/> ha6 (rtos a6 2 4)<br/> ha7 (rtos a7 2 4)<br/> ha8 (rtos a8 2 4)<br/>)<br/>))))))<br/>(cond ((= bqbb "LINE") <br/>(cond ((= dqbb "LINE") <br/>(cond ((> xuui 0) <br/>(cond ((/= hdd "0.00")<br/>(cond ((/= hdd "90.00")<br/>(cond ((/= hdd "180.00")<br/>(cond ((/= hdd "270.00")<br/>(cond ((= hadd hdd)<br/>(cond ((<= aad ad)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> aad ad)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))))<br/>(cond ((= hade hdd)<br/>(cond ((<= aad ad)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> aad ad)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))))<br/>))))))))<br/>(cond ((= ha2 ha8)<br/>(cond ((= hdd "0.00")<br/>(cond ((= hadd "0.00")<br/>(cond ((<= a1 a5)<br/>(cond ((>= a3 a7)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((< a3 a7)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" qst aqed "")<br/>(setq zz (+ zz 1))<br/>))))<br/>(cond ((> a1 a5)<br/>(cond ((<= a3 a7)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> a3 a7)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" aqst qed "")<br/>(setq zz (+ zz 1))<br/>))))<br/>))<br/>(cond ((= hadd "180.00")<br/>(cond ((<= a1 a7)<br/>(cond ((>= a3 a5)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((< a3 a5)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" qst aqst "")<br/>(setq zz (+ zz 1))<br/>))))<br/>(cond ((> a1 a7)<br/>(cond ((<= a3 a5)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> a3 a5)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" aqed qed "")<br/>(setq zz (+ zz 1))<br/>))))<br/>))))<br/>(cond ((= hdd "180.00")<br/>(cond ((= hadd "180.00")<br/>(cond ((<= a3 a7)<br/>(cond ((>= a1 a5)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((< a1 a5)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" qed aqst "")<br/>(setq zz (+ zz 1))<br/>))))<br/>(cond ((> a3 a7)<br/>(cond ((<= a1 a5)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> a1 a5)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" aqed qst "")<br/>(setq zz (+ zz 1))<br/>))))<br/>))<br/>(cond ((= hadd "0.00")<br/>(cond ((<= a3 a5)<br/>(cond ((>= a1 a7)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((< a1 a7)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" qed aqed "")<br/>(setq zz (+ zz 1))<br/>))))<br/>(cond ((> a3 a5)<br/>(cond ((<= a1 a7)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> a1 a7)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" aqst qst "")<br/>(setq zz (+ zz 1))<br/>))))<br/>))))<br/>)) <br/>(cond ((= ha1 ha5)<br/>(cond ((= hdd "90.00")<br/>(cond ((= hadd "90.00")<br/>(cond ((<= a2 a6)<br/>(cond ((>= a4 a8)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((< a4 a8)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" qst aqed "")<br/>(setq zz (+ zz 1))<br/>))))<br/>(cond ((> a2 a6)<br/>(cond ((<= a4 a8)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> a4 a8)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" aqst qed "")<br/>(setq zz (+ zz 1))<br/>))))<br/>))<br/>(cond ((= hadd "270.00")<br/>(cond ((<= a2 a8)<br/>(cond ((>= a4 a6)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((< a4 a6)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" aqst qst "")<br/>(setq zz (+ zz 1))<br/>))))</p><p>(cond ((> a2 a8)<br/>(cond ((<= a4 a6)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> a4 a6)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" aqed qed "")<br/>(setq zz (+ zz 1))<br/>))))<br/>))))<br/>(cond ((= hdd "270.00")<br/>(cond ((= hadd "270.00")<br/>(cond ((<= a4 a8)<br/>(cond ((>= a2 a6)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((< a2 a6)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" qed aqst "")<br/>(setq zz (+ zz 1))<br/>))))<br/>(cond ((> a4 a8)<br/>(cond ((<= a2 a6)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> a2 a6)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" aqed qst "")<br/>(setq zz (+ zz 1))<br/>))))<br/>))<br/>(cond ((= hadd "90.00")<br/>(cond ((<= a4 a6)<br/>(cond ((>= a2 a8)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((< a2 a8)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" qed aqed "")<br/>(setq zz (+ zz 1))<br/>))))<br/>(cond ((> a4 a6)<br/>(cond ((<= a2 a8)<br/>(entdel caab)<br/>(setq zz (+ zz 1))<br/>))<br/>(cond ((> a2 a8)<br/>(entdel caab)<br/>(entdel baab)<br/>(command "line" aqst qst "")<br/>(setq zz (+ zz 1))<br/>))))<br/>))))<br/>))<br/>))<br/>))<br/>)) <br/>(setq xuui (+ xuui 1))<br/>) <br/>));))<br/>(cond ((= bb "CIRCLE")<br/> (setq bst (cdr (assoc 10 (entget aab))))<br/> (setq bed (cdr (assoc 40 (entget aab))))<br/>(setq qxa (polar bst (/ p 2.0) bed))<br/>; (setq jqaa (ssget "c" qxa qxa '((0 . "CIRCLE")(0 . "ARC"))))<br/> (setq jqaa (ssget "c" qxa qxa '((-4 . "<OR")(-4 . "<AND")(0 . "CIRCLE")<br/>(-4 . "AND>") (-4 . "<AND")(0 . "ARC")(-4 . "AND>")(-4 . "OR>"))))<br/>; (setq jqaa (ssget "c" qxa qxa ))<br/> (setq uui 0)<br/> (setq qab (ssadd))<br/> (repeat (sslength jqaa)<br/> (setq jqaab (ssname jqaa uui))<br/> (setq wqbb (cdr (assoc 0 (entget jqaab))))<br/>(cond ((= wqbb "CIRCLE")<br/>(cond ((= uui 0)<br/> (setq bst (cdr (assoc 10 (entget jqaab))))<br/> (setq bed (cdr (assoc 40 (entget jqaab))))<br/>(setq sa1 (car bst)<br/> sa2 (cadr bst)<br/> sha11 (rtos bed 2 4)<br/> sha1 (rtos sa1 2 3)<br/> sha2 (rtos sa2 2 3))<br/>))<br/>(cond ((> uui 0)<br/> (setq baab (ssname jqaa uui))<br/> (setq bqbb (cdr (assoc 0 (entget baab))))<br/> (setq bcst (cdr (assoc 10 (entget baab))))<br/> (setq bced (cdr (assoc 40 (entget baab))))<br/>(setq sa3 (car bcst)<br/> sa4 (cadr bcst)<br/> sha12 (rtos bced 2 4)<br/> sha3 (rtos sa3 2 3)<br/> sha4 (rtos sa4 2 3))<br/>))))<br/>(cond ((= wqbb "CIRCLE")<br/>(cond ((> uui 0)<br/>(cond ((= sha1 sha3)<br/>(cond ((= sha2 sha4)<br/>(cond ((= sha12 sha11)<br/>(entdel baab)<br/>(setq zz (+ zz 1))<br/>))))))))))<br/>(setq uui (+ uui 1))<br/>))<br/>)<br/>(cond ((= bb "ARC")<br/> (setq aab (ssname aa ui))<br/> (setq qbb (cdr (assoc 0 (entget aab))))<br/> (setq dst (cdr (assoc 10 (entget aab))))<br/> (setq ast (cdr (assoc 50 (entget aab))))<br/> (setq sst (cdr (assoc 51 (entget aab))))<br/> (setq beed (cdr (assoc 40 (entget aab))))<br/>(cond ((> ast sst)<br/>(cond ((<= ast p)<br/>(setq xb (+(- p ast) g sst))<br/>(setq xxb (/ xb 2.0))<br/>(setq xb (+ ast xxb))))<br/>(cond ((<= ast pi)<br/>(setq xb (+(- pi ast) pi sst))<br/>(setq xxb (/ xb 2.0))<br/>(setq xb (+ ast xxb))))<br/>(cond ((<= ast g)<br/>(setq xb (+(- g ast) p sst))<br/>(setq xxb (/ xb 2.0))<br/>(setq xb (+ ast xxb))))<br/>(cond ((<= ast (* pi 2.0))<br/>(setq xb (+(- (* pi 2.0) ast)sst))<br/>(setq xxb (/ xb 2.0))<br/>(setq xb (+ ast xxb))))<br/>))<br/>(cond ((< ast sst)<br/>(setq xb (- sst ast))<br/>(setq xxb (/ xb 2.0))<br/>(setq xb (+ ast xxb))))<br/>(setq<br/> qxa (polar dst xb beed))<br/>; (setq sqaa (ssget "c" qxa qxa ))<br/> (setq sqaa (ssget "c" qxa qxa '((-4 . "<OR")(-4 . "<AND")(0 . "ARC")<br/>(-4 . "AND>") (-4 . "<AND")(0 . "CIRCLE")(-4 . "AND>")(-4 . "OR>"))))<br/> (setq yuui 0) <br/> (setq qab (ssadd))<br/> (repeat (sslength sqaa)<br/> (setq qaab (ssname sqaa yuui))<br/> (setq aqbb (cdr (assoc 0 (entget qaab))))<br/>(cond ((= yuui 0)<br/>(cond ((= aqbb "ARC")<br/> (setq xqaab (ssname sqaa yuui))<br/> (setq saqbb (cdr (assoc 0 (entget xqaab))))<br/> (setq dst (cdr (assoc 10 (entget xqaab))))<br/> (setq ast (cdr (assoc 50 (entget xqaab))))<br/> (setq sst (cdr (assoc 51 (entget xqaab))))<br/> (setq beed (cdr (assoc 40 (entget xqaab))))<br/>(setq yui 0)<br/>(setq <br/> wa1 (car dst)<br/> wa2 (cadr dst)<br/> qha1 (rtos wa1 2 3)<br/> qha2 (rtos wa2 2 3)<br/> qha3 (rtos ast 2 3)<br/> qha4 (rtos sst 2 3)<br/> qha11 (rtos beed 2 4))<br/>))<br/>(cond ((= aqbb "CIRCLE")<br/> (setq eaab (ssname sqaa yuui))<br/> (setq waqbb (cdr (assoc 0 (entget eaab))))<br/> (setq bqbb (cdr (assoc 0 (entget eaab))))<br/> (setq bcst (cdr (assoc 10 (entget eaab))))<br/> (setq cbed (cdr (assoc 40 (entget eaab))))<br/>(setq yui 1)<br/>(setq a9 (car bcst)<br/> a10 (cadr bcst)<br/> qha9 (rtos a9 2 3)<br/> qha10 (rtos a10 2 3)<br/> qha12 (rtos cbed 2 4))<br/>))<br/>))<br/>(cond ((> yuui 0)<br/>(cond ((= aqbb "ARC")<br/> (setq xqaab (ssname sqaa yuui))<br/> (setq saqbb (cdr (assoc 0 (entget xqaab))))<br/> (setq cdst (cdr (assoc 10 (entget xqaab))))<br/> (setq cast (cdr (assoc 50 (entget xqaab))))<br/> (setq csst (cdr (assoc 51 (entget xqaab))))<br/> (setq cbeed (cdr (assoc 40 (entget xqaab))))<br/>(setq <br/> wa5 (car cdst)<br/> wa6 (cadr cdst)<br/> qha5 (rtos wa5 2 3)<br/> qha6 (rtos wa6 2 3)<br/> qha7 (rtos cast 2 3)<br/> qha8 (rtos csst 2 3)<br/> qha11 (rtos cbeed 2 4))<br/>))<br/>(cond ((= aqbb "CIRCLE")<br/> (setq eaab (ssname qaa yuui))<br/> (setq waqbb (cdr (assoc 0 (entget eaab))))<br/> (setq bqbb (cdr (assoc 0 (entget eaab))))<br/> (setq bcst (cdr (assoc 10 (entget eaab))))<br/> (setq cbed (cdr (assoc 40 (entget eaab))))<br/>(setq a9 (car bcst)<br/> a10 (cadr bcst)<br/> qha9 (rtos a9 2 3)<br/> qha10 (rtos a10 2 3)<br/> qha12 (rtos cbed 2 4))<br/>))<br/>))<br/>(cond ((> yuui 0)<br/>(cond ((= bb "ARC")<br/>(cond ((= saqbb "ARC")<br/>(cond ((= cbeed beed)<br/>(cond ((= qha1 qha5)<br/>(cond ((= qha2 qha6)<br/>(cond ((= qha3 qha7)<br/>(cond ((= qha4 qha8)<br/>(entdel xqaab)<br/>(setq zz (+ zz 1))<br/>))))))))))))<br/>(cond ((= yui 0)<br/>(cond ((= waqbb "CIRCLE")<br/>(cond ((= saqbb "ARC")<br/>(cond ((= qha11 qha12)<br/>(cond ((= qha1 qha9)<br/>(cond ((= qha2 qha10)<br/>(entdel xqaab)<br/>(setq zz (+ zz 1))))))))))))))<br/>(cond ((= yui 1)<br/>(cond ((= waqbb "CIRCLE")<br/>(cond ((= saqbb "ARC")<br/>(cond ((= qha11 qha12)<br/>(cond ((= qha5 qha9)<br/>(cond ((= qha6 qha10)<br/>(entdel xqaab)<br/>(setq zz (+ zz 1))))))))))))))</p><p>))))</p><p>(setq yuui (+ yuui 1))<br/>))<br/>)<br/>(setq ui (+ ui 1))<br/>)<br/>(setq sss "册除重复线")<br/>(setq ss1 "条")<br/>(setq aqqq (rtos zz 2 0))<br/>(prompt (strcat sss aqqq ss1))<br/>(command "pickbox" 5)<br/>(command "dim" "dimzin" 8 "e")<br/>(princ)<br/>)<br/></p> 能删除重复圆孔吗 <p>探索者自带的还不错</p> 本帖最后由 zag0666 于 2011-3-29 15:56 编辑AutoCAD 2006\Express
可惜不能发附件
添加以下附件
acetauto.lsp
acetdomnu.fas
acettest.fas
acetutil2.fas
acetutil3.fas
acetutil4.fas
acetutil.arx
acetutil.dll
acetutil.fas
overkill.dcl
overkill.lsp
Overkillsup.lsp
小题大做啊！ 用CAD的EXPRESSTOOLS的OVERKILL.LSP 感谢楼主分享，下去试一下。 可以看一下，无所不及编的柱体积配箍率的程序，里面有一个删除重复线的函数，编的不错。可以去.jgcad.com找 在那里有啊
好东西啊，哈哈 又学了一招。
页:
[1]
2