;******************************************************************
;Program:  DelDupLine.lsp
;Name:     Tihomir Bojanic, dipl.ing.geodezije
;Country:  Serbia
;Sity:     Novi Sad
;Adress:   Sterijina 15/15
;Mail:     tikab@nadlanu.com
;Language: Serbian
;Date:     27.11.2008.
;********************************************************************
(defun DELDUPLINE(LEN dec / i k Ta Tb Ts Uo Us RED LLN LDEL Dd VRED MID YX0 MODU STKORD)
 ; Deleting dubble and small (< 1/10^dec) entitets LINE
 ; LEN - selected set of LINE entities
 ; dec - precision (Number of decimal)

 (defun VRED(Kod EN / ) ;get DXF Value assoc Kod entitets
  (cdr (assoc Kod (entget EN)))
 )
 (defun MID(T1 T2 / )  ; get MID point
  (list (/ (+ (car T1) (car T2)) 2.0) (/ (+ (cadr T1) (cadr T2)) 2.0))
 )
 (defun YX0(YXZ / )  ;get 2D point
  (list (car YXZ) (cadr YXZ))
 )
 (defun MODU(Au / PI2 Bu) ;get Angle in First 2PI period
  (setq PI2 (* 2.0 pi) Bu (- Au (* PI2 (fix (/ Au PI2)))))
  (if (< Bu 0)(setq Bu (+ Bu PI2)))
  Bu
 )
 (defun STKORD(YX dec / )  ;get ASSOC string from Y and X
  (strcat (rtos (car YX) 2 dec) " " (rtos (cadr YX) 2 dec))
 )
 (if (/= LEN nil)(progn
  (setq i (sslength LEN) LLN '() LDEL (ssadd) Dd (/ 1.0 (expt 10 dec)))
  (while (> i 0)
   (setq i (1- i) EN (ssname LEN i) Ta (vred 10 EN) Tb (vred 11 EN) k nil)
   (if (> (distance (yx0 Ta) (yx0 Tb)) Dd)(progn
    (setq Uo (modu (angle Ta Tb)))(if (> Uo pi)(setq Uo (- Uo pi)))
    (setq Ts (stkord (mid Ta Tb) dec) Us (rtos Uo 2 6) RED (assoc Ts LLN))
    (if (= RED nil)
     (setq LLN (cons (list Ts Us) LLN) k T)
     (if (= (member Us (cdr RED)) nil)(setq LLN (cons (append RED (list Us)) LLN) k T))
    )
   ))
   (if (= k nil)(setq LDEL (ssadd EN LDEL)))
   (print (list i (sslength LEN)))
  )
  (princ (strcat "\nDeleted " (itoa (sslength LDEL)) " dubble LINE entitets \n"))
  (command "ERASE" LDEL "")
 ))
)
;********************************************************************
; Function to test deldupline
;********************************************************************
(defun C:TESTDL( / LEN)
 ;(UZMI0)
 (setq LEN (ssget '((0 . "LINE"))))
 (deldupline LEN 4)
 ;(VRATI0)
 (princ)
)
(princ)