Ok, as promised here si the final code. I added a few thingies to it and added error functionality.
(defun tag_err (msg) ;; error handler
(tag_exit)
(if
(or
(= msg "Function cancelled")
(= msg "quit / exit abort")
)
(princ)
(princ (strcat "\nError: msg"))
);end if
(princ)
);end tag_err
(defun tag_start () ;; startup function
(command "_.UNDO" "BEGIN")
(setq olderr *error*
*error* tag_err)
(setq oldecho (getvar "cmdecho"))
(setvar "cmdecho" 0)
(princ)
);end tag_start
(defun tag_exit () ;; exit function
(setvar "cmdecho" oldecho)
(setq *error* olderr
olderr nil)
(command "_.UNDO" "END")
(princ)
);end tag_exit
(defun c:tag ( / Keyw SS dwgprefix# dir dwgname count e xd )
(tag_start)
(setvar "cmdecho" 0) ;switch off command echo
(initget 0 "Select All")
(setq Keyw (getkword "\nEnter selection option (Select / All) <All> : ")) ;;Select one, multiple or all LWPOLYLINE's
(if (or
(= Keyw "")
(null Keyw)
);end or
(setq Keyw "All")
(setq Keyw "Select")
)
(cond
((= Keyw "Select")(setq SS (ssget '((0 . "LWPOLYLINE")))))
((= Keyw "All")(setq SS (ssget "X" '((0 . "LWPOLYLINE")))))
)
;check if the application has been registered
(if (not (tblsearch "APPID" "CP_INFO"))
;if not, register it
(regapp "CP_INFO"))
;Get dwgprefix,... once
(setq dwgprefix# (getvar "dwgprefix"))
(setq dir (substr dwgprefix# 20 6))
(strip_extension (getvar "dwgname"))
(setq dwgname (strip_extension (getvar "dwgname")))
(setq Count 0)
;loop SS-list
(repeat (sslength SS)
;select one entity from list
(setq e (entget (ssname SS Count)))
;if there is no exdata
(if (not (assoc -3 e))
(progn
;create new xdata list
(setq xd (list (list -3 (list "CP_INFO"
(cons 1000 "CP_TAG|SPACE")
(cons 1000 (strcat "dde|" dir "|" dwgname "|" (cdr (assoc 5 e)))))
)))
;append it and entmod
(setq e (append e xd))
(entmod e)
(setq Count (+ Count 1))
));end if end progn
);end repeat
(tag_exit)
(princ)
)
(defun strip_extension (filename / cnt fname found)
(setq cnt 1
fname "")
(repeat (strlen filename)
(if (= (substr filename cnt 1) ".")
(setq found T)
)
(if (not found)
(setq fname (strcat fname (substr filename cnt 1)))
) ;end if
(setq cnt (1+ cnt))
) ;end repeat
(eval fname)
)
Thanks again for the help.