prefix lisp routine

[danielbentley]

Iv been trying to change the below lisp (unsucessfully) to add a prefix to an attribute with tag "PARTNUMBER" in a bunch of blocks. The routine i found online somewhere and is perfect but it adds the prefix/suffix to all attributes. Can someone help with adding the missing parts which select the attribute i need to change. Many thanks

(defun c:test ( / as el en i ss str typ )

  (initget "Prefix Suffix")
  (setq typ (cond ((getkword "\nAdd Prefix or Suffix? [Prefix/Suffix] <Prefix>: ")) ("Prefix")))
  (setq str (getstring t (strcat typ " to Add: ")))

  (if (setq ss (ssget '((0 . "INSERT") (66 . 1))))
      (repeat (setq i (sslength ss))
          (setq en (ssname ss (setq i (1- i))))
          (while (eq "ATTRIB" (cdr (assoc 0 (setq el (entget (setq en (entnext en)))))))
              (setq as (cdr (assoc 1 el)))
              (if (eq "Prefix" typ)
                  (if (not (wcmatch as (strcat str "*")))
                      (entmod (subst (cons 1 (strcat str as)) (assoc 1 el) el))
                  )
                  (if (not (wcmatch as (strcat "*" str)))
                      (entmod (subst (cons 1 (strcat as str)) (assoc 1 el) el))
                  )
              )
          )
      )
  )
  (princ)
)

[Lee_Mac · Accepted solution]

I recognise that code

Try the following modification:

(defun c:test ( / ent enx exs fun idx pat sel str typ )
    (initget "Prefix Suffix")
    (setq typ (cond ((getkword "\nAdd Prefix or Suffix? [Prefix/Suffix] <Prefix>: ")) ("Prefix"))
          str (getstring t (strcat "\n" typ " to add: "))
    )
    (if (= "Prefix" typ)
        (setq pat (strcat "~" str "*")
              fun (lambda ( x ) (strcat str x))
        )
        (setq pat (strcat "~*" str)
              fun (lambda ( x ) (strcat x str))
        )
    )
    (if (setq sel (ssget '((0 . "INSERT") (66 . 1))))
        (repeat (setq idx (sslength sel))
            (setq ent (entnext (ssname sel (setq idx (1- idx))))
                  enx (entget ent)
            )
            (while (= "ATTRIB" (cdr (assoc 0 enx)))
                (if (and (= "PARTNUMBER" (cdr (assoc 2 enx))) (wcmatch (cdr (setq exs (assoc 1 enx))) pat))
                    (entmod (subst (cons 1 (fun (cdr exs))) exs enx))
                )
                (setq ent (entnext ent)
                      enx (entget  ent)
                )
            )
        )
    )
    (princ)
)

Lee

[danielbentley]

Awesome, thanks for that. I knew what it needed but couldn't get it to work.

[Lee_Mac]

You're very welcome Daniel.