Matching pattern of two strings

[Jonathan Handojo]

Hi all,

 

Here's an interesting one I'm coming across. I'm looking for a function that can find the matching pattern between two strings and return its wildcard matching pattern. Any "non-match" can be replaced by an asterisk and then continue to the next matching pattern.

 

I would also prefer if there could be a minimum of at least three characters between each asterisk of the resulting matching pattern (so that it doesn't get too specific), but if it's not possible, then that's also fine.

 

For example, suppose the two strings supplied are:

 

Drawing_12_1297-2241079-LEVEL 50 - PRESSURE SERVICES - ZONE 3

Drawing_6_1303-2241073-LEVEL 50 - PRESSURE SERVICES - ZONE 3

 

I'd like the function to return something like this:

 

Drawing_*`-224107*`-LEVEL 50 `- PRESSURE SERVICES `- ZONE 3

 

The reason I'm asking this is because I've got many blocks in a drawing with very similar naming patterns extracted from other software into AutoCAD, so if I could get this pattern it'll save me time with selecting these blocks.

 

Thanks,

Jonathan Handojo

[marko_ribar]

;;; pattern matching between 2 strings ;;;
;;; https://www.cadtutor.net/forum/topic/74031-matching-pattern-of-two-strings/

(defun str1mchstr2 ( str1 str2 / unique* car-sort l1 l2 a r f )

  (defun unique* ( l / a r )
    (while (setq a (car l))
      (if (and (= a 42) (vl-position 42 (cdr l)))
        (setq r (cons a r) l (member (vl-some (function (lambda ( x ) (if (/= x 42) x))) l) l))
        (setq r (cons a r) l (cdr l))
      )
    )
    (reverse r)
  )

  (defun car-sort ( lst cmp / rtn )
    (setq rtn (car lst))
    (foreach itm (cdr lst)
      (if (apply cmp (list itm rtn))
        (setq rtn itm)
      )
    )
    rtn
  )

  (setq l1 (vl-string->list str1))
  (setq l2 (vl-string->list str2))
  (while (setq a (car l1))
    (setq l1 (cdr l1))
    (if (= a (car l2))
      (setq r (cons a r) l2 (cdr l2) f nil)
      (setq r (cons 42 r) l2 (if (and (null f) (vl-position a l2)) (car-sort (vl-remove nil (mapcar (function (lambda ( x ) (member x l2))) l1)) (function (lambda ( a b ) (> (length a) (length b))))) l2) f t)
    )
  )
  (vl-list->string (unique* (reverse r)))
)

;;;
(defun c:ttt nil (str1mchstr2 "Drawing_12_1297-2241079-LEVEL 50 - PRESSURE SERVICES - ZONE 3" "Drawing_6_1303-2241073-LEVEL 50 - PRESSURE SERVICES - ZONE 3"))
;;;
;;; "Drawing_*_1*3" - better matching than this can't be computed and not to disrupt logic of operations - IMHO ;;;

[Steven P]

Is there some logic behind your block naming? For example a dash or underscore to separate groupings, and that similar block types have similar groupings? that might make it easier 

(for example your block name might be made up as 'drawing'_'drawing number 1'_'drawing number 2'-'drawing number 3'-'Level number' - 'service type' - 'zone')

If there is a common group separator then could you use Lee Macs string to list (http://lee-mac.com/stringtolist.html), split up all the text into a list, you will have to modify it a bit to include a few delimitators or run through the list once for each delimitator (so you might use "_". " - " and "-"?). Then compare list items, I think that is what Marko above is doing with his comparison?

[marko_ribar]

I've corrected sub...

I over programmed again...

 

;;; pattern matching between 2 strings ;;;
;;; https://www.cadtutor.net/forum/topic/74031-matching-pattern-of-two-strings/

(defun str1mchstr2 ( str1 str2 / unique* l1 l2 l2o a r q )

  (defun unique* ( l / a r )
    (while (setq a (car l))
      (if (and (= a 42) (vl-position 42 (cdr l)))
        (setq r (cons a r) l (member (vl-some (function (lambda ( x ) (if (/= x 42) x))) l) l))
        (setq r (cons a r) l (cdr l))
      )
    )
    (reverse r)
  )

  (setq l1 (vl-string->list str1))
  (setq l2 (vl-string->list str2))
  (setq l2o l2)
  (while (setq a (car l1))
    (setq l1 (cdr l1))
    (if (= a (car l2))
      (setq r (cons a r) l2 (cdr l2))
      (setq r (cons 42 r) l2 (if (= (car l1) (car l2)) l2 (if (vl-position (car l1) l2) (if (vl-position (car l1) r) (progn (setq q l2o) (repeat (1+ (- (length r) (length (vl-remove (car l1) r)))) (setq q (cdr (member (car l1) q)))) (setq q (cons (car l1) q))) (cdr l2)) (cdr l2))))
    )
  )
  (vl-list->string (unique* (reverse r)))
)

 

;;;
(defun c:ttt1 nil (str1mchstr2 "Drawing_12_1297-2241079-LEVEL 50 - PRESSURE SERVICES - ZONE 3" "Drawing_6_1303-2241073-LEVEL 50 - PRESSURE SERVICES - ZONE 3"))
(defun c:ttt2 nil (str1mchstr2 "Drawing_6_1303-2241073-LEVEL 50 - PRESSURE SERVICES - ZONE 3" "Drawing_12_1297-2241079-LEVEL 50 - PRESSURE SERVICES - ZONE 3"))
;;;
;;; "Drawing_*_1*-224107*-LEVEL 50 - PRESSURE SERVICES - ZONE 3" ;;;

 

HTH. M.R.

Edited November 20, 2021 by marko_ribar

[Jonathan Handojo]

16 hours ago, Steven P said:

Is there some logic behind your block naming? For example a dash or underscore to separate groupings, and that similar block types have similar groupings? that might make it easier 

(for example your block name might be made up as 'drawing'_'drawing number 1'_'drawing number 2'-'drawing number 3'-'Level number' - 'service type' - 'zone')

If there is a common group separator then could you use Lee Macs string to list (http://lee-mac.com/stringtolist.html), split up all the text into a list, you will have to modify it a bit to include a few delimitators or run through the list once for each delimitator (so you might use "_". " - " and "-"?). Then compare list items, I think that is what Marko above is doing with his comparison?

 

No, there isn't any logic behind it. It's because I'm working with other third parties, and they may have all sorts of different naming system. Just to give a background, I work where third parties extract families from Revit and export them into AutoCAD as blocks. As an example, one of my jobs is to have a certain block (of my own) placed on the insertion point of many other blocks (with the similar names). It makes the whole process easier if I can just ssget based on their names if they are exactly the same blocks, but as you move on from project to project, it's just impossible to find a fixed naming system, but surprisingly their names are always very similar regardless.

 

So my idea was to create a command where I prompt the user to select any two of the desired blocks first, get this string matching pattern, and then integrate this in ssget or wcmatch filtering operations to be able to select the entire drawing. It may not get 100% of it, but at least it can cut the work by getting 85% done.

 

3 hours ago, marko_ribar said:

I've corrected sub...

I over programmed again...

 

;;; pattern matching between 2 strings ;;;
;;; https://www.cadtutor.net/forum/topic/74031-matching-pattern-of-two-strings/

(defun str1mchstr2 ( str1 str2 / unique* l1 l2 l2o a r q )

  (defun unique* ( l / a r )
    (while (setq a (car l))
      (if (and (= a 42) (vl-position 42 (cdr l)))
        (setq r (cons a r) l (member (vl-some (function (lambda ( x ) (if (/= x 42) x))) l) l))
        (setq r (cons a r) l (cdr l))
      )
    )
    (reverse r)
  )

  (setq l1 (vl-string->list str1))
  (setq l2 (vl-string->list str2))
  (setq l2o l2)
  (while (setq a (car l1))
    (setq l1 (cdr l1))
    (if (= a (car l2))
      (setq r (cons a r) l2 (cdr l2))
      (setq r (cons 42 r) l2 (if (= (car l1) (car l2)) l2 (if (vl-position (car l1) l2) (if (vl-position (car l1) r) (progn (setq q l2o) (repeat (1+ (- (length r) (length (vl-remove (car l1) r)))) (setq q (cdr (member (car l1) q)))) (setq q (cons (car l1) q))) (cdr l2)) (cdr l2))))
    )
  )
  (vl-list->string (unique* (reverse r)))
)

 

;;;
(defun c:ttt1 nil (str1mchstr2 "Drawing_12_1297-2241079-LEVEL 50 - PRESSURE SERVICES - ZONE 3" "Drawing_6_1303-2241073-LEVEL 50 - PRESSURE SERVICES - ZONE 3"))
(defun c:ttt2 nil (str1mchstr2 "Drawing_6_1303-2241073-LEVEL 50 - PRESSURE SERVICES - ZONE 3" "Drawing_12_1297-2241079-LEVEL 50 - PRESSURE SERVICES - ZONE 3"))
;;;
;;; "Drawing_*_1*-224107*-LEVEL 50 - PRESSURE SERVICES - ZONE 3" ;;;

 

HTH. M.R.

 

Thanks a lot Marko! It works great. I'll have to study this.

[marko_ribar]

Just to inform that there are new inputs regarding this topic subject...

 

Relevant link :

https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/pbe-challenge-wcmatch-patterns/td-p/10960223

 

Regards, M.R.