[编程交流] 重复数字文本查找器

(defun c:LTD (/ LWPoly _dupl ssD data);LineToDuplicate
(defun _ftf (pt m)
         (polar pt (if m (* pi 0.25) (* pi 1.25))(* 0.05 (sqrt 2))))
 (defun LWPoly        (lst clr)
   (foreach att lst
     (vla-getboundingbox att 'mn 'mx)
     (setq p1 (_ftf (vlax-safearray->list mn) nil)
           p3 (_ftf (vlax-safearray->list mx) t)
           p2 (list (car p1)(cadr p3) 0.0)
    p4 (list (car p3)(cadr p1) 0.0))
(entmakex
     (append (list (cons 0 "LWPOLYLINE")
            (cons 100 "AcDbEntity")
            (cons 100 "AcDbPolyline")
            (cons 8 "DuplicateLine")
            (cons 62 clr)
            (cons 70 1)
            (cons 90 (length (setq lst (list p1 p2 p3 p4 p1))))
                                   )
      (mapcar (function (lambda (p) (cons 10 p))) lst)
                             )
                   )        
)
)
(Defun _numb (str)
 (vl-list->string
   (vl-remove-if-not
     '(lambda (n)
 (< 47 n 58)
      )
     (vl-string->list str)
   )
 )
)
(defun _dupl (itm  / a b c d e f)
(while (setq a (Car itm))
(setq b         (cdr itm) id (car a))
(while (setq d (assoc id b))
  (setq        e (cons d e)
        b (vl-remove d b)))
(if e
  (setq f (cons (cons a e) f)))
(setq itm b e nil)
)
 f)
 (if (setq data nil ssD (ssget "_X" (list
                               '(0 . "INSERT")
                              '(2 . "BOM_LINE*")
                               '(66 . 1)
                               (cons 410 (getvar 'ctab)))))
   (progn
           (repeat (setq i (sslength ssd))
  (setq data (cons 
          (mapcar        (function (lambda (l)
                            (list (vla-get-tagstring l)
                                  (_numb (vla-get-textstring l))
                                  l
                            )
                          )
                )
                (vlax-invoke
                  (vlax-ename->vla-object
                    (ssname ssd (setq i (1- i)))
                  )
                  'GetAttributes
                )
        ) data))
  )
     (setq data (apply 'append data))
     (foreach itm '("DESCRIPTION" "SAPNUMBER")
        (set (setq df (Read itm))
             (vl-remove-if-not '(lambda (l)
                                  (and (eq (car l) itm)
                                       (/= (cadr l) ""))) data))
)
     (setq col 0)
     (foreach itm 
(setq des (_dupl (mapcar 'cdr DESCRIPTION)))
(print (caar itm))
(setq col (1+ col))
(LWPoly (mapcar 'cadr itm) col)
)
     (foreach itm (setq sap (_dupl (mapcar 'cdr SAPNUMBER)))
(print (caar itm))
(setq col (1+ col))
(LWPoly (mapcar 'cadr itm) col)
     )
     )
     
)
   (princ (cond
     ((null ssd) "\nNo valid selection")
     ((and (null des)
          (null sap)) "\nNo Duplicates Found")))
 (princ)
)

 
(defun c:DUPL (/ erdup)
               (if 
    (tblsearch "LAYER" "DuplicateLine")    
   (if (setq erdup (ssget "_x" '((8 . "DuplicateLine"))))
      (progn
              (command "erase" erdup "")
               (Command "-Purge" "la" "DuplicateLine" "n")
     );end progn
         ); end if2
   (princ "\nLayer not found")
               ); end if1
); end defun