[分享]册除重复线

zag0666

网上找的，东西不错，就是不够完善，斜线删除会误删，请高手修改。

(defun c:adk ()
(graphscr)
(setvar "cmdecho" 0)
(command "pickbox" 3)
(command "dim" "dimzin" 0 "e")
  (setq cen (getvar "viewctr"))
  (setq vpt1 (getvar "vsmin"))
  (setq vpt2 (getvar "vsmax"))
(setq
     p  (/ pi 2.0)
     g (+ pi p))
(setq aa (ssget "c" vpt1 vpt2 ))
(command "pickbox" 0)
   (setq zz 0)
   (setq ui 0)
   (setq ab (ssadd))
(princ "\n 请稍候;正在去除......")
   (repeat (sslength aa)
   (setq aab (ssname aa ui))
     (setq bb (cdr (assoc 0 (entget aab))))
(cond ((= bb "LINE")
(setq qst (cdr (assoc 11 (entget aab))))
(setq qed (cdr (assoc 10 (entget aab))))
(setq qedq (cdr (assoc 210 (entget aab))))
(setq ad (distance qst qed)
      dd (angle qst qed)
      de (angle qed qst)
)  
;(cond ((> ad 4)
(setq aj (/ ad 2.25))
(setq aq (/ ad 3.0))
(setq qxa (polar qst dd aj))
(setq qxb (polar qst dd aq))
(setq pt1 (list (car qxa)(cadr qxa)))
   (setq qaa (ssget "c" qxa qxb '((0 . "LINE"))))
;   (setq qaa (ssget '(4.4444 10.0)))
   (setq xuui 0)
   (setq qab (ssadd))
   (repeat (sslength qaa)
   (setq qaab (ssname qaa xuui))
     (setq qbb (cdr (assoc 0 (entget qaab))))
(cond ((= qbb "LINE") 
(cond ((= xuui 0)  
   (setq caab (ssname qaa xuui))
   (setq dqbb (cdr (assoc 0 (entget caab))))
(cond ((= dqbb "LINE")
(setq qst (cdr (assoc 11 (entget caab))))
(setq qed (cdr (assoc 10 (entget caab))))
(setq ad (distance qst qed)
      dd (angle qst qed)
      de (angle qed qst)
      hdd (angtos dd 0 2)
)
(setq a1 (car qst)
      a2 (cadr qst)
      a3 (car qed)
      a4 (cadr qed)
      ha1 (rtos a1 2 4)
      ha2 (rtos a2 2 4)
      ha3 (rtos a3 2 4)
      ha4 (rtos a4 2 4)
)
))))       
(cond ((>= xuui 1)
   (setq baab (ssname qaa xuui))
   (setq bqbb (cdr (assoc 0 (entget baab))))
(cond ((= bqbb "LINE") 
(setq aqst (cdr (assoc 11 (entget baab))))
(setq aqed (cdr (assoc 10 (entget baab))))
(setq aad (distance aqst aqed)
      add (angle aqst aqed)
      ade (angle aqed aqst)
      hadd (angtos add 0 2)
      hade (angtos ade 0 2)
)
(setq a5 (car aqst)
      a6 (cadr aqst)
      a7 (car aqed)
      a8 (cadr aqed)
      ha5 (rtos a5 2 4)
      ha6 (rtos a6 2 4)
      ha7 (rtos a7 2 4)
      ha8 (rtos a8 2 4)
)
))))))
(cond ((= bqbb "LINE") 
(cond ((= dqbb "LINE")
(cond ((> xuui 0) 
(cond ((/= hdd "0.00")
(cond ((/= hdd "90.00")
(cond ((/= hdd "180.00")
(cond ((/= hdd "270.00")
(cond ((= hadd hdd)
(cond ((<= aad ad)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((> aad ad)
(entdel caab)
(setq zz (+ zz 1))
))))
(cond ((= hade hdd)
(cond ((<= aad ad)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((> aad ad)
(entdel caab)
(setq zz (+ zz 1))
))))
))))))))
(cond ((= ha2 ha8)
(cond ((= hdd "0.00")
(cond ((= hadd "0.00")
(cond ((<= a1 a5)
(cond ((>= a3 a7)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((< a3 a7)
(entdel caab)
(entdel baab)
(command "line" qst aqed "")
(setq zz (+ zz 1))
))))
(cond ((> a1 a5)
(cond ((<= a3 a7)
(entdel caab)
(setq zz (+ zz 1))
))
(cond ((> a3 a7)
(entdel caab)
(entdel baab)
(command "line" aqst qed "")
(setq zz (+ zz 1))
))))
))
(cond ((= hadd "180.00")
(cond ((<= a1 a7)
(cond ((>= a3 a5)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((< a3 a5)
(entdel caab)
(entdel baab)
(command "line" qst aqst "")
(setq zz (+ zz 1))
))))
(cond ((> a1 a7)
(cond ((<= a3 a5)
(entdel caab)
(setq zz (+ zz 1))
))
(cond ((> a3 a5)
(entdel caab)
(entdel baab)
(command "line" aqed qed "")
(setq zz (+ zz 1))
))))
))))
(cond ((= hdd "180.00")
(cond ((= hadd "180.00")
(cond ((<= a3 a7)
(cond ((>= a1 a5)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((< a1 a5)
(entdel caab)
(entdel baab)
(command "line" qed aqst "")
(setq zz (+ zz 1))
))))
(cond ((> a3 a7)
(cond ((<= a1 a5)
(entdel caab)
(setq zz (+ zz 1))
))
(cond ((> a1 a5)
(entdel caab)
(entdel baab)
(command "line" aqed qst "")
(setq zz (+ zz 1))
))))
))
(cond ((= hadd "0.00")
(cond ((<= a3 a5)
(cond ((>= a1 a7)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((< a1 a7)
(entdel caab)
(entdel baab)
(command "line" qed aqed "")
(setq zz (+ zz 1))
))))
(cond ((> a3 a5)
(cond ((<= a1 a7)
(entdel caab)
(setq zz (+ zz 1))
))
(cond ((> a1 a7)
(entdel caab)
(entdel baab)
(command "line" aqst qst "")
(setq zz (+ zz 1))
))))
))))
))             
(cond ((= ha1 ha5)
(cond ((= hdd "90.00")
(cond ((= hadd "90.00")
(cond ((<= a2 a6)
(cond ((>= a4 a8)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((< a4 a8)
(entdel caab)
(entdel baab)
(command "line" qst aqed "")
(setq zz (+ zz 1))
))))
(cond ((> a2 a6)
(cond ((<= a4 a8)
(entdel caab)
(setq zz (+ zz 1))
))
(cond ((> a4 a8)
(entdel caab)
(entdel baab)
(command "line" aqst qed "")
(setq zz (+ zz 1))
))))
))
(cond ((= hadd "270.00")
(cond ((<= a2 a8)
(cond ((>= a4 a6)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((< a4 a6)
(entdel caab)
(entdel baab)
(command "line" aqst qst "")
(setq zz (+ zz 1))
))))

(cond ((> a2 a8)
(cond ((<= a4 a6)
(entdel caab)
(setq zz (+ zz 1))
))
(cond ((> a4 a6)
(entdel caab)
(entdel baab)
(command "line" aqed qed "")
(setq zz (+ zz 1))
))))
))))
(cond ((= hdd "270.00")
(cond ((= hadd "270.00")
(cond ((<= a4 a8)
(cond ((>= a2 a6)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((< a2 a6)
(entdel caab)
(entdel baab)
(command "line" qed aqst "")
(setq zz (+ zz 1))
))))
(cond ((> a4 a8)
(cond ((<= a2 a6)
(entdel caab)
(setq zz (+ zz 1))
))
(cond ((> a2 a6)
(entdel caab)
(entdel baab)
(command "line" aqed qst "")
(setq zz (+ zz 1))
))))
))
(cond ((= hadd "90.00")
(cond ((<= a4 a6)
(cond ((>= a2 a8)
(entdel baab)
(setq zz (+ zz 1))
))
(cond ((< a2 a8)
(entdel caab)
(entdel baab)
(command "line" qed aqed "")
(setq zz (+ zz 1))
))))
(cond ((> a4 a6)
(cond ((<= a2 a8)
(entdel caab)
(setq zz (+ zz 1))
))
(cond ((> a2 a8)
(entdel caab)
(entdel baab)
(command "line" aqst qst "")
(setq zz (+ zz 1))
))))
))))
))
))
))
))       
(setq xuui (+ xuui 1))
)    
));))
(cond ((= bb "CIRCLE")
  (setq bst (cdr (assoc 10 (entget aab))))
  (setq bed (cdr (assoc 40 (entget aab))))
(setq qxa (polar bst (/ p 2.0) bed))
;   (setq jqaa (ssget "c" qxa qxa '((0 . "CIRCLE")(0 . "ARC"))))
   (setq jqaa (ssget "c" qxa qxa '((-4 . "<OR")(-4 . "<AND")(0 . "CIRCLE")
(-4 . "AND>") (-4 . "<AND")(0 . "ARC")(-4 . "AND>")(-4 . "OR>"))))
;   (setq jqaa (ssget "c" qxa qxa ))
   (setq uui 0)
   (setq qab (ssadd))
   (repeat (sslength jqaa)
   (setq jqaab (ssname jqaa uui))
     (setq wqbb (cdr (assoc 0 (entget jqaab))))
(cond ((= wqbb "CIRCLE")
(cond ((= uui 0)
  (setq bst (cdr (assoc 10 (entget jqaab))))
  (setq bed (cdr (assoc 40 (entget jqaab))))
(setq sa1 (car bst)
      sa2 (cadr bst)
      sha11 (rtos bed 2 4)
      sha1 (rtos sa1 2 3)
      sha2 (rtos sa2 2 3))
))
(cond ((> uui 0)
   (setq baab (ssname jqaa uui))
   (setq bqbb (cdr (assoc 0 (entget baab))))
  (setq bcst (cdr (assoc 10 (entget baab))))
  (setq bced (cdr (assoc 40 (entget baab))))
(setq sa3 (car bcst)
      sa4 (cadr bcst)
      sha12 (rtos bced 2 4)
      sha3 (rtos sa3 2 3)
      sha4 (rtos sa4 2 3))
))))
(cond ((= wqbb "CIRCLE")
(cond ((> uui 0)
(cond ((= sha1 sha3)
(cond ((= sha2 sha4)
(cond ((= sha12 sha11)
(entdel baab)
(setq zz (+ zz 1))
))))))))))
(setq uui (+ uui 1))
))
)
(cond ((= bb "ARC")
     (setq aab (ssname aa ui))
     (setq qbb (cdr (assoc 0 (entget aab))))
  (setq dst (cdr (assoc 10 (entget aab))))
  (setq ast (cdr (assoc 50 (entget aab))))
  (setq sst (cdr (assoc 51 (entget aab))))
  (setq beed (cdr (assoc 40 (entget aab))))
(cond ((> ast sst)
(cond ((<= ast p)
(setq xb (+(- p ast) g sst))
(setq xxb (/ xb 2.0))
(setq xb (+ ast xxb))))
(cond ((<= ast pi)
(setq xb (+(- pi ast) pi sst))
(setq xxb (/ xb 2.0))
(setq xb (+ ast xxb))))
(cond ((<= ast g)
(setq xb (+(- g ast) p sst))
(setq xxb (/ xb 2.0))
(setq xb (+ ast xxb))))
(cond ((<= ast (* pi 2.0))
(setq xb (+(- (* pi 2.0) ast)sst))
(setq xxb (/ xb 2.0))
(setq xb (+ ast xxb))))
))
(cond ((< ast sst)
(setq xb (- sst ast))
(setq xxb (/ xb 2.0))
(setq xb (+ ast xxb))))
(setq
      qxa (polar dst xb beed))
;   (setq sqaa (ssget "c" qxa qxa ))
   (setq sqaa (ssget "c" qxa qxa '((-4 . "<OR")(-4 . "<AND")(0 . "ARC")
(-4 . "AND>") (-4 . "<AND")(0 . "CIRCLE")(-4 . "AND>")(-4 . "OR>"))))
   (setq yuui 0)  
   (setq qab (ssadd))
   (repeat (sslength sqaa)
   (setq qaab (ssname sqaa yuui))
     (setq aqbb (cdr (assoc 0 (entget qaab))))
(cond ((= yuui 0)
(cond ((= aqbb "ARC")
   (setq xqaab (ssname sqaa yuui))
     (setq saqbb (cdr (assoc 0 (entget xqaab))))
  (setq dst (cdr (assoc 10 (entget xqaab))))
  (setq ast (cdr (assoc 50 (entget xqaab))))
  (setq sst (cdr (assoc 51 (entget xqaab))))
  (setq beed (cdr (assoc 40 (entget xqaab))))
(setq yui 0)
(setq   
      wa1 (car dst)
      wa2 (cadr dst)
      qha1 (rtos wa1 2 3)
      qha2 (rtos wa2 2 3)
      qha3 (rtos ast 2 3)
      qha4 (rtos sst 2 3)
      qha11 (rtos beed 2 4))
))
(cond ((= aqbb "CIRCLE")
   (setq eaab (ssname sqaa yuui))
     (setq waqbb (cdr (assoc 0 (entget eaab))))
   (setq bqbb (cdr (assoc 0 (entget eaab))))
  (setq bcst (cdr (assoc 10 (entget eaab))))
  (setq cbed (cdr (assoc 40 (entget eaab))))
(setq yui 1)
(setq a9 (car bcst)
      a10 (cadr bcst)
      qha9 (rtos a9 2 3)
      qha10 (rtos a10 2 3)
      qha12 (rtos cbed 2 4))
))
))
(cond ((> yuui 0)
(cond ((= aqbb "ARC")
   (setq xqaab (ssname sqaa yuui))
     (setq saqbb (cdr (assoc 0 (entget xqaab))))
  (setq cdst (cdr (assoc 10 (entget xqaab))))
  (setq cast (cdr (assoc 50 (entget xqaab))))
  (setq csst (cdr (assoc 51 (entget xqaab))))
  (setq cbeed (cdr (assoc 40 (entget xqaab))))
(setq   
      wa5 (car cdst)
      wa6 (cadr cdst)
      qha5 (rtos wa5 2 3)
      qha6 (rtos wa6 2 3)
      qha7 (rtos cast 2 3)
      qha8 (rtos csst 2 3)
      qha11 (rtos cbeed 2 4))
))
(cond ((= aqbb "CIRCLE")
   (setq eaab (ssname qaa yuui))
     (setq waqbb (cdr (assoc 0 (entget eaab))))
   (setq bqbb (cdr (assoc 0 (entget eaab))))
  (setq bcst (cdr (assoc 10 (entget eaab))))
  (setq cbed (cdr (assoc 40 (entget eaab))))
(setq a9 (car bcst)
      a10 (cadr bcst)
      qha9 (rtos a9 2 3)
      qha10 (rtos a10 2 3)
      qha12 (rtos cbed 2 4))
))
))
(cond ((> yuui 0)
(cond ((= bb "ARC")
(cond ((= saqbb "ARC")
(cond ((= cbeed beed)
(cond ((= qha1 qha5)
(cond ((= qha2 qha6)
(cond ((= qha3 qha7)
(cond ((= qha4 qha8)
(entdel xqaab)
(setq zz (+ zz 1))
))))))))))))
(cond ((= yui 0)
(cond ((= waqbb "CIRCLE")
(cond ((= saqbb "ARC")
(cond ((= qha11 qha12)
(cond ((= qha1 qha9)
(cond ((= qha2 qha10)
(entdel xqaab)
(setq zz (+ zz 1))))))))))))))
(cond ((= yui 1)
(cond ((= waqbb "CIRCLE")
(cond ((= saqbb "ARC")
(cond ((= qha11 qha12)
(cond ((= qha5 qha9)
(cond ((= qha6 qha10)
(entdel xqaab)
(setq zz (+ zz 1))))))))))))))

))))

(setq yuui (+ yuui 1))
))
)
(setq ui (+ ui 1))
)
(setq sss "册除重复线")
(setq ss1 "条")
(setq aqqq (rtos zz 2 0))
(prompt (strcat sss aqqq ss1))
(command "pickbox" 5)
(command "dim" "dimzin" 8 "e")
(princ)
)

至今没学会

能删除重复圆孔吗

jishen

探索者自带的还不错

zag0666

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

MaKaiJin

小题大做啊！

yhkk0317

用CAD的EXPRESSTOOLS的OVERKILL.LSP

苍天白鹤

感谢楼主分享，下去试一下。

springwillow

可以看一下，无所不及编的柱体积配箍率的程序，里面有一个删除重复线的函数，编的不错。可以去.jgcad.com找

lichunyu

在那里有啊      

jxcaixiaomeng

好东西啊，哈哈   

13579

又学了一招。