duplicate items on list

is there a vlisp equivalent of removing duplicate items on a list

(setq ls_vl '("1" "2" "2" "A" "B" "B"))
(foreach Nm_al ls_vl 
     (if (not (member Nm_al tst_lst))
         (setq tst_lst (cons Nm_al tst_lst))))

(vl-sort ls_vl '

tried it with string values.. doesnt seem to work

From a friend of mine.

(defun RemoveDuplicates (lst / temp)
 ;; Remove duplicates
 ;; 
 ;; This routine will remove duplicate items from a list
 ;;
 ;; By: Michael Puckett
 ;;
 (vl-remove-if
   '(lambda (x)
       (cond
         ((vl-position x temp) t)
         ((setq temp (cons x temp)) nil)
         )
       )
     lst
   )
 )

(defun LM:Unique ( l )
 (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)

From a friend of mine.

Something up with your paren's mate

question for Lee why wouldn't vl-sort work? I did this a little bit ago and it works on my routine...

 
(defun c:MS-FILE (/ flag dcl tmp lst # lst2 cfile dir filename)
 (vl-load-com)
 (if (eq (findfile (setq filename (strcat (getvar 'roamablerootprefix) "Support\\MS-FILE.dcl"))) nil)
   (progn
     (setq f (open filename  "w"))
     (foreach str '("main"
": dialog {"
"  label = \"Program name here\";"
"  :boxed_column {"
"    label = \"Add/Remove box\";"
"    alignment = centered;"
"    :row {"
"      : list_box {"
"        label = \"List\";"
"        key = \"lst\";"
"        height = 15;"
"        width = 25;"
"        multiple_select = true;"
"      }"
"      : column {"
"        spacer;"
"        spacer;"
"        : button {"
"          key = \"browse\";"
"          label = \"Browse\";"
"        }"
"        : button {"
"          label = \"<- Add\";"
"          key = \"add\";"
"        }"
"        : button {"
"          label = \"Remove ->\";"
"          key = \"remove\";"
"        }"
"        spacer;"
"        spacer;"
"      }"
"      : list_box {"
"        label = \"Browse\";"
"        key = \"lst2\";"
"        height = 15;"
"        width = 25;"
"        multiple_select = true;"
"      }"
"    }"
"    spacer;"
"  }"
"  :column {"
"    spacer; "
"    ok_cancel;"
"    spacer;"
"    : text {"
"      label = \"¤ Created by: Reid Booe - 2010 ¤\";"
"      alignment = centered;"
"    }"
"  }"
"}")
(write-line str f))
     (setq f (close f))
   )
 )
 (setq flag 4 lst nil)
 (while (> flag 2)
   (setq dcl (load_dialog filename))
   (if (not (new_dialog "main" dcl))
     (progn
(prompt "\nDCL missing from support path!")
       (exit)
     )
   )
   (start_list "lst")
   (mapcar 'add_list lst)
   (end_list)
   (start_list "lst2")
   (mapcar 'add_list lst2)
   (end_list)
   (if (eq lst2 nil)
     (progn (mode_tile "lst2" 1)(mode_tile "add" 1)(mode_tile "remove" 1))
     (progn (mode_tile "lst2" 0)(set_tile "lst2" "0")(mode_tile "add" 0))
   )
   (if (eq lst nil)
     (progn (mode_tile "lst" 1)(mode_tile "remove" 1))
     (progn (mode_tile "lst" 0)(set_tile "lst" "0")(mode_tile "remove" 0))
   )
   (action_tile "add" "(setq tmp (get_tile \"lst2\"))
                       (setq tmp (mapcar '(lambda ($#) (nth $# lst2))
                              (read (strcat \"(\" tmp \")\"))))(setq lst (vl-sort (setq lst (append tmp lst)) '<))
                       (start_list \"lst\")(mapcar 'add_list lst)(end_list)
                       (mode_tile \"lst\" 0)(set_tile \"lst\" \"0\")(mode_tile \"remove\" 0)")
   (action_tile "remove" "(setq tmp (get_tile \"lst\") # 0)(setq tmp (mapcar '(lambda ($#) (nth $# lst))
                              (read (strcat \"(\" tmp \")\"))))(repeat (length tmp)
                       (setq lst (vl-remove (nth # tmp) lst))(setq # (1+ #)))
                       (start_list \"lst\")(mapcar 'add_list lst)(end_list)(if (eq lst nil)
                       (progn (mode_tile \"lst\" 1)(mode_tile \"remove\" 1))(set_tile \"lst\" \"0\"))")
   (action_tile "browse" "(done_dialog 3)")
   (action_tile "cancel" "(done_dialog 0)")
   (action_tile "accept" "(done_dialog 1)")
   (setq flag (start_dialog))
   (unload_dialog dcl)
   
   (cond ((eq flag 0)(prompt "\n*Cancel*"))
  ((eq flag 3)
    (if (setq cfile (getfiled "Select a dwg" "" "dwg" 4))
               (setq lst2 (car (list (vl-directory-files (setq dir (vl-filename-directory cfile)) "*.dwg"))))
           )
         )
        ((eq flag 1)(prompt "\nPlace lisp routine here!"))
   )
 )
 (princ)
)

The purpose of vl-sort is to sort a list of items - not remove duplicates - the fact that duplicates are removed is a 'side-effect', and usually occurs when sorting numerical elements.

Duplicate elements may be eliminated from the list.

Hence, this would theoretically work, but I would avoid its usage for such a task:

(mapcar 'chr (vl-sort (mapcar 'ascii '("1" "3" "3" "4" "1")) '<))

(defun LM:Unique ( l )
 (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
)

Cheese and rice Lee .. how'd you come up with that... so short yet so simple

one more query while you're at it...

(setq dd '("8" "11" "8" "9" "10" "11" "7" "12")
n_lst
(LM:UNIQUE dd))
("8" "11" "9" "10" "7" "12")

(mapcar 'chr (vl-sort (mapcar 'ascii dd) '<))
("1" "7" "8" "9")

why is it ignoring "11" & "12"?

nice routine Lt. Dan

I have been cases that the

(defun mip_MakeUniqueMembersOfList  ( lst / OutList head)
 (while lst
   (setq head (car lst)
         OutList (cons head OutList)
         lst (vl-remove-if '(lambda(pt)(equal pt head 1e-6))(cdr lst))
         )
   )
 (reverse OutList)
 )
(defun mip_MakeUniqueMembersOfListWithCount  ( lst / OutList head countelt)
 (while lst
   (setq head (car lst)
  countelt 0
         lst (vl-remove-if '(lambda(pt)(if ([color="red"]equal pt head 1e-6[/color])(setq countelt (1+ countelt)) nil)) lst)
         OutList (append OutList (list (cons head countelt)))))
 OutList
 )

Use

(setq dd '("8" "11" "8" "9" "10" "11" "7" "12"))
(mip_MakeUniqueMembersOfList dd)
;_("8" "11" "9" "10" "7" "12") 
(mip_MakeUniqueMembersOfListWithCount dd)
;_(("8" . 2) ("11" . 2) ("9" . 1) ("10" . 1) ("7" . 1) ("12" . 1)) 

I have been cases that the

(setq dd '("8" "11" "8" "9" "10" "11" "7" "12"))
(mip_MakeUniqueMembersOfList dd)
;_("8" "11" "9" "10" "7" "12") 
(mip_MakeUniqueMembersOfListWithCount dd)
;_(("8" . 2) ("11" . 2) ("9" . 1) ("10" . 1) ("7" . 1) ("12" . 1)) 

I'll try this later c",)

Here's whats happening.. this lisp will look for the last Number/Letter of a spcific block.. this way it reduce the chance on part of the user

in double tagging, its works okay... thnaks a whole bunch to you guys but once it hits "10" ... bam... no go!

(defun c:Detitle ()         ;<--------- tool palette accessible
  (setq dtl_bl (ssget "x" '((0 . "INSERT")(66 . 1)(410 . "Model")))
       ttl_val nil nth_nos 0)
  (foreach dtl_sl 
   (mapcar 'cadr(ssnamex dtl_bl))
 (if 
   (/= (vla-get-EffectiveName (vlax-ename->vla-object dtl_sl)) "DETAG")
       (ssdel dtl_sl dtl_bl)))
(setq dtl_lst (mapcar 'vlax-ename->vla-object (mapcar 'cadr(ssnamex dtl_bl))))
  (foreach Lst_nm dtl_lst
 (setq ttl_val (cons
   (vla-get-textstring (nth 1 
    (vlax-safearray->list (variant-value (vla-getattributes Lst_nm))))) ttl_val)
       )
  )
  (setq ttl_val (vl-sort  (LM:Unique ttl_val) '<))  ;;; by Lee Mac
 (if (/= (length ttl_val)(length dtl_lst))
  (princ "\n<<<<<<<<<< Please Check title for duplicate number/letter>>>>>>>>>>")
    (srt_list ttl_val))(princ)
  )
   
(defun srt_list (ttl_val)
  (while (< nth_nos (length ttl_val))
   (if (> (atoi  (nth nth_nos ttl_val)) 0)
      (setq N_ls (nth nth_nos ttl_val))
      (setq L_ls (nth nth_nos ttl_val))
     )(setq nth_nos (1+ nth_nos))
   )
  (if (not L_ls)
   (setq L_ls "@"))
(setq L_ls (vl-list->string (mapcar '1+ (vl-string->list L_ls)))
    N_ls (itoa (1+ (atoi N_ls))))
  (ins_me L_ls N_ls)
)
 
(defun ins_me (L_ls N_ls / wr_dis d_val ds_pt do_dis)
      
  (princ (strcat "\nNext Letter <" L_ls ">"))
  (princ (strcat "\nNext Number <" N_ls ">"))(princ)
  (initget 1 "Letter Number")
  (setq wr_dis (getkword "\nEnter Option [Letter/Number]: " ))
  (cond
   ((= wr_dis "Letter")(setq d_val L_ls))
 ((= wr_dis "Number")(setq d_val N_ls))
 )
(setq ds_pt (getpoint "\nInsertion Point")
do_dis
  (vla-insertblock  (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))
  (vlax-3d-point ds_pt) "DETAG"
 1 1 1 0)
 )
 
 (vla-put-textstring (cadr      ;why the 2nd attribute?
 (vlax-safearray->list (variant-value (vla-getattributes do_dis))) ; the first is constant on this block
 ) d_val)
 )

;<<<<<<<<<< Lee Mac 2010 >>>>>>>>>
(defun LM:Unique ( l )
 (if l (cons (car l) (LM:Unique (vl-remove (car l) (cdr l)))))
  )

Any suggestions?

Thanks a mil

is there a vlisp equivalent of removing duplicate items on a list

(setq ls_vl '("1" "2" "2" "A" "B" "B"))
(foreach Nm_al ls_vl 
     (if (not (member Nm_al tst_lst))
         (setq tst_lst (cons Nm_al tst_lst))))

 

I may be missing something, but what's wrong with your original code? You may have convert the strcase of all atoms, but I believe the (vl) functions would have to do the same thing. -David

I may be missing something, but what's wrong with your original code? You may have convert the strcase of all atoms, but I believe the (vl) functions would have to do the same thing. -David

The code is okay David thak you for asking... i just want to learn new stuff really... modifying and sorting the list at the same time. i can write it using lisp sorting and everything but

I was thinking more of making the code shorter via VLISP which by the way fascinates me.. i've bee using lisp for a long time and keep putting off learning how how to write codes using VLISP

the thing that really got me stumped with lisp is when i encountered Dynamic/Annotative/Anonymous names stuff like that.. which i noticed easier to extract and edit via VLISP.

A month ago i started learning VBA, i even bought a book.. but BAM!! i read somewhere that Autodesk is dropping VBA (not totally though) in place of NET... but thats another story :wink:

Thank you for your insights D.

Is (acad_strlsort) still around? It doesn't get much cleaner coding than that!

I've looked in the VL stuff as well. 95% of it just doesn't float my boat. Command names are too long, too complex, too cryptic. There are some curve functions that are cool.

If I were to start a new language today, I think I'd opt for a .net or I'd finally try to become more proficient in php or java or some other web based code.

There may be some additions to VLisp in the future, but my guess is that ADesk has flushed it out as much as it wants too. My $0.02. -David

(acet-list-remove-duplicates (list) nil)

(acet-list-remove-duplicates (list) nil)

whooa. where did that come from? thats a good one...

My my.. so many things to learn... so little time...

thanks dude....

whooa. where did that come from? thats a good one...

Yes its available - only if you have Express Tools installed however. It is an Express Tools function, and one that I wouldn't rely on...

whooa. where did that come from? thats a good one...

 

My my.. so many things to learn... so little time...

 

thanks dude....

That only works if your cad has express tool (Acetutil.arx), and i agree with Lee Mac and so i prefer Lee's function (elegant function).

mardi

Yes its available - only if you have Express Tools installed however. It is an Express Tools function, and one that I wouldn't rely on...

now that you mentioned it.. you're right..... i never did have much use for Express tools except Cookie Cutter Trim.. i dont believe they still have that though... hmmmmmn

There are many acet-* functions, but I would rely on them too much in an application.

Express Tools Functions:

http://www.theswamp.org/index.php?action=dlattach;topic=28777.0;attach=12477

http://www.theswamp.org/index.php?topic=13719.0

http://www.theswamp.org/index.php?topic=19505.0