Search a list from another list using 3 characters of the first list

[Strydaris]

Hey everyone,

 

I am trying to write some code to create a list of strings.

Basically I have 2 lists. 

Oldlst ("Door" "Win-1" Win-2" "Text")

Newlst ("G-DOOR" "G-WINDOW" "G-TEXT" "WD-TEXT")

 

I am trying to create some code that will start off using the first 3 characters of the first item in the oldlst.

It will then search the newlst for a matching string using those 3 characters. 

So 1st item in oldlst would be Door, then uses DOO to search the newlst and matches with G-DOOR. Then continues down the newlst to see if there is another match.

If not then continue onto the 2nd string in the oldlst and search the newlst for a 3 character match etc etc

 

I was thinking that using vl-string-search would do the trick, but from what I have read, vl-string-search stops after it finds a match.

Another option that I though might work is vl-every since I want it to go through the entire list searching for all possible matches with 3 characters, but that doesnt seem to work or at least I cant figure it out.

I am using foreach to cycle through the first list, but I am not very familiar with the VL functions.

This is what I have so far... I think it just needs some minor tweaking / help. I could be wrong though.

Basically when it finds a match in the newlst, I want to create another temporary list to use as a initget selection for the user to pick which one is a better match.

 

   (foreach oldlayer oldlst
      (setq oldlayer (strcase (substr oldlayer 1 3)))
      (if  (vl-every '(lambda (x) (/= (vl-string-search oldlayer x) nil)) newlst)
	   (prompt "/nDO SOMTHING WHEN IT SUCCEEDS")
	   (prompt "/nDO SOMTHING WHEN IT FAILS")
      )
   )

 

[exceed]

(defun c:FOO ( / oldlst newlst resultlst oldlayer getlst newlayer gatom j glen)
  (setq oldlst (list "Door" "Win-1" "Win-2" "Text" "ttt"))
  (setq newlst (list "G-DOOR" "G-WINDOW" "G-TEXT" "WD-TEXT"))
  (setq resultlst '())
  (foreach oldlayer oldlst
    (setq getlst '())
    (foreach newlayer newlst
      (if (wcmatch (strcase newlayer) (strcat "*" (strcase (substr oldlayer 1 3)) "*"))
        (progn
          (setq getlst (cons newlayer getlst))
        )
        (progn)
      )
    )
    (setq getlst (reverse getlst))
    (cond
      ((= getlst nil) (setq getlst (list "no result")))
      ((> (setq glen (length getlst)) 1)
        (princ "\n You have ")
        (princ glen)
        (princ (strcat " options for this keyword : " oldlayer ))
        (setq i 0)
        (repeat glen
          (setq gatom (nth i getlst))
          (princ "\n ")
          (princ (+ i 1))
          (princ " > ")
          (princ gatom)
          (setq i (+ i 1))
        )
        (initget 7)
        (setq j (getint "\n Enter the number you want : "))
        (if (> j glen) 
          (progn 
            (princ "\n That number is greater than the lists. It is automatically adjusted to the maximum number.")
            (setq j glen) 
          )
        )
        (setq getlst (list (nth (- j 1) getlst)))
      )
    )
    (setq resultlst (cons (list oldlayer (car getlst)) resultlst))
  )
  (setq resultlst (reverse resultlst))
  (princ "\n")
  (princ resultlst)
  (princ)
)

 

Command : FOO
 You have 2 options for this keyword : Text
 1 > G-TEXT
 2 > WD-TEXT
 Enter the number you want : 1
 result pair list - ((Door G-DOOR) (Win-1 G-WINDOW) (Win-2 G-WINDOW) (Text G-TEXT) (ttt no result))


Command : foo
 You have 2 options for this keyword : Text
 1 > G-TEXT
 2 > WD-TEXT
 Enter the number you want : 2
 result pair list - ((Door G-DOOR) (Win-1 G-WINDOW) (Win-2 G-WINDOW) (Text WD-TEXT) (ttt no result))


Command : foo
 You have 2 options for this keyword : Text
 1 > G-TEXT
 2 > WD-TEXT
 Enter the number you want : 3
 That number is greater than the lists. It is automatically adjusted to the maximum number.
 result pair list - ((Door G-DOOR) (Win-1 G-WINDOW) (Win-2 G-WINDOW) (Text WD-TEXT) (ttt no result))

 

Edited November 23, 2023 by exceed

[Strydaris]

Thanks @exceed.

I was thinking it could be done using VL functions.

I didn't think of using a double foreach, but that makes sense since I want to check each string in Oldlst against each string in newlst.

At first I thought your code was a bit long for what I was asking, then I noticed all the (princ) you used for text formatting.

I could probably condense that area to match how I want it laid out.

 

Thank you so much though.

I originally used this code which I made, but found it very VERY slow for what I was using it for and couldn't think of a way to speed it up.

 

(defun strmatch	(str1 str2 / i match leng1 leng2 i1 i2)
   (setq match nil)
   (setq leng1 3 ;Length of string to use
	 i1    1 ;Start from the first character
   )
   (setq leng2 3 ;Length of newlayers to check
	 i2    1 ;Start from the first character
   )
   (while (and (not match)(<= i1 (- (strlen str1) 2))(< i2 (- (strlen str2) 2)))
      (if (= (strcase (substr str1 i1 leng1))(strcase (substr str2 i2 leng2)))
	 (setq match t)
	 (setq i2 (1+ i2))
      ) ;_if
   ) ;_while
   match
   (princ)
) ;_defun

 

[Lee Mac]

Something like this perhaps?

(mapcar '(lambda ( x ) (cons x (vl-remove-if-not '(lambda ( y ) (wcmatch (strcase y) (strcat "*" (strcase (substr x 1 3)) "*"))) newlst))) oldlst)

 

Result -

(("Door" "G-DOOR") ("Win-1" "G-WINDOW") ("Win-2" "G-WINDOW") ("Text" "G-TEXT" "WD-TEXT"))

 

You may or may not wish to remove null groups (i.e. where the old entry has no matches).

Edited November 23, 2023 by Lee Mac

[Strydaris]

Hey @Lee Mac

I was trying to that method earlier but I couldnt figure it out.

The idea behind this is to translate old layers to newer layers for ACAD 2024 LT since it doesnt have laytrans.

I plan to take the resulting list(s) and just use -laymrg to update older files from to our newer layer system.

I already have the code setup to grab existing layers and put them into a list as well as create all the new layers after the old layer list is created.

This was the last bit of code I couldnt figure out, other than my really slow method I posted above.

 

Thank you so much Lee. You are always a great help to these forums.

I also expect there to be a couple null matches, but having a few that the user will have to manually merge is a lot better than 30 or 40 layers.

Maybe I will present those groups at the end of the code as a prompt to tell the user that those layers had no match.

[BIGAL]

"translate old layers to newer layers" using a more old fashioned method can make a list ((newlay oldlay)(......)) then just use Rename layer. This is ok if the dwg is fairly consistent with the layer naming of the old layers. You can dump the layers to a list or a file and then make a new list that is in a lisp that is supported by LT24.

Dump layers.

(defun wow ( / )
(setq lst '())
(vlax-for lay (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
(setq lst (cons (list (vlax-get lay 'name) "X") lst))
)
(princ lst)
)
(wow)

Just use F2 and copy to notepad.

Edited November 23, 2023 by BIGAL

[Strydaris]

@BIGAL

I thought about doing the renaming of layers, but there is so much inconsistencies across projects in our office that renaming them I don't think would work efficiently. Plus we are changing layer colours and updating blocks etc etc. 

Maybe simply renaming for very similar layers like Doors for example might work, but we also have things like Win-1, win-2 and E-Win. These are being consolated down to 1 simple G-Windows. In this case I feel layer merge is the best option. 

Also I have a bit of OCD when I see layer names in lower case, so the lisp I made is forcing all new layers to be uppercase. 

If it comes down to it, what I can try and do is force a rename on single matches only. 

Maybe add in

(if (= (length match) 2)

Rename old layer to newlayer and change the colour. 

Else Ask user which newlayer to merge with. 

 

Thanks for the suggestion Bigal