Filename in Field Form

September 12, 2017

Hi again, I need help.

I want the user to pick a TEXT, MTEXT or Attribute and the lisp will input the Filename of the drawing in Field form as value (without the filename extension .dwg)

Can it be done?

September 12, 2017

Yes - use Visual LISP to populate the Text, MText or Attribute content with the appropriate Field Expression - you will also need to use the UPDATEFIELD command or REGEN when populating Attributes with Fields.

September 12, 2017

Yes - use Visual LISP to populate the Text, MText or Attribute content with the appropriate Field Expression - you will also need to use the UPDATEFIELD command or REGEN when populating Attributes with Fields.

i found this lisp of yours, but it is inserting a FIELD and not selecting...

i do not know how to modify this one...

(defun c:addnme (/ doc spc pt)
 (vl-load-com)
 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 (if (setq pt (getpoint "\nSelect Point for Field: "))
   (vla-AddMText spc
     (vlax-3D-point pt) 0 "%<\\AcDiesel $(getvar,dwgname)>%"))
 (princ))

September 13, 2017

A simplified example

(setq obj (vlax-ename->vla-object (car (entsel "\nPick text or mtext "))))
(vla-put-textstring obj "%<[url="file://\\AcDiesel"]\\AcDiesel[/url] $(getvar,dwgname)>%")

September 13, 2017

A simplified example

(setq obj (vlax-ename->vla-object (car (entsel "\nPick text or mtext "))))
(vla-put-textstring obj "%<[url="file://\\AcDiesel"]\\AcDiesel[/url] $(getvar,dwgname)>%")

thanks for the assistance... I'd like to use fields instead of diesel

(defun c:addnme (/ doc spc pt)
 (vl-load-com)
 (setq doc (vla-get-ActiveDocument (vlax-get-Acad-Object))
       spc (if (zerop (vla-get-activespace doc))
             (if (= (vla-get-mspace doc) :vlax-true)
               (vla-get-modelspace doc)
               (vla-get-paperspace doc))
             (vla-get-modelspace doc)))
 ; (if (setq pt (getpoint "\nSelect Point for Field: "))
   ; (vla-AddMText spc
     ; (vlax-3D-point pt) 0 "%<[url="file://\\AcDiesel"]\\AcDiesel[/url] $(getvar,dwgname)>%"))
(setq obj (vlax-ename->vla-object (car (entsel "\nPick text or mtext "))))
; (vla-put-textstring obj "%<[url="file://\\AcDiesel"]\\AcDiesel[/url] $(getvar,dwgname)>%")   
(vla-put-textstring obj "%<\AcVar Filename \f "%tc1%fn2">%")   
 (princ)
)

I'm getting an error :

Pick text or mtext ; error: Too many actual parameters

September 13, 2017

Just this a shot.

(defun c:Foo (/ pck)
 (and (setq pck (car (nentsel "\nPick Text/Mtext/Attribute :")))
      (or (wcmatch (cdr (assoc 0 (entget pck))) "TEXT,MTEXT,ATTRIB")
          (alert "Invalid object <!>"))
      (progn
        (vla-put-textstring (vlax-ename->vla-object pck) "%<\\AcVar Filename \\f \"%fn2\">%")
        (vla-regen (vla-get-activedocument (vlax-get-acad-object)) Acactiveviewport)
        )
      )  
 (princ)
) (vl-load-com)

September 13, 2017

Just this a shot.

(defun c:Foo (/ pck)
 (and (setq pck (car (nentsel "\nPick Text/Mtext/Attribute :")))
      (or (wcmatch (cdr (assoc 0 (entget pck))) "TEXT,MTEXT,ATTRIB")
          (alert "Invalid object <!>"))
      (progn
        (vla-put-textstring (vlax-ename->vla-object pck) "%<\\AcVar Filename \\f \"%fn2\">%")
        (vla-regen (vla-get-activedocument (vlax-get-acad-object)) Acactiveviewport)
        )
      )  
 (princ)
) (vl-load-com)

Works perfectly! Thank you so much Tharwat.

Can I ask for a little modification?

if the layer is locked, unlock it write the filename and lock it again...

Hope you get what i mean

September 13, 2017

Works perfectly! Thank you so much Tharwat.
Can I ask for a little modification?

if the layer is locked, unlock it write the filename and lock it again...

Hope you get what i mean

Try this:

(defun c:foo (/ doc pck lck get)
 ;;--------------------------------------------;;
 ;; 	Tharwat - Date: 13.Sep.2017		;;
 ;; Drawing name to field without extension	;;
 ;;--------------------------------------------;;
 (and (setq pck (car (nentsel "\nPick Text/Mtext/Attribute :")))
      (or (wcmatch (cdr (assoc 0 (entget pck))) "TEXT,MTEXT,ATTRIB")
          (alert "Invalid object <!>")
      )
      (progn
        (setq doc (vla-get-activedocument (vlax-get-acad-object)))
        (if
          (eq 4
              (logand
                4
                (cdr (assoc 70
                            (setq get (entget (tblobjname
                                                "LAYER"
                                                (cdr (assoc 8 (entget pck)))
                                              )
                                      )
                            )
                     )
                )
              )
          )
           (entmod (subst '(70 . 0) (setq lck (assoc 70 get)) get))
        )
        (vla-put-textstring (vlax-ename->vla-object pck) "%<\\AcVar Filename \\f \"%fn2\">%" )
        (if lck (entmod (subst lck (assoc 70 get) get)))
        (vla-regen doc acactiveviewport)
      )
 )
 (princ)
) (vl-load-com)

September 13, 2017

Perfect! Much appreciated.

Thank you!!!

September 13, 2017

Perfect! Much appreciated.
Thank you!!!

You are welcome anytime.

NOTE: I did a minor mods after a minute of posting the codes so recopy the codes again to have the latest.

September 13, 2017

You are welcome anytime.

NOTE: I did a minor mods after a minute of posting the codes so recopy the codes again to have the latest.

Noted. thanks.

April 28, 2022

On 9/13/2017 at 4:31 PM, Tharwat said:

Try this:

(defun c:foo (/ doc pck lck get)
 ;;--------------------------------------------;;
 ;; 	Tharwat - Date: 13.Sep.2017		;;
 ;; Drawing name to field without extension	;;
 ;;--------------------------------------------;;
 (and (setq pck (car (nentsel "\nPick Text/Mtext/Attribute :")))
      (or (wcmatch (cdr (assoc 0 (entget pck))) "TEXT,MTEXT,ATTRIB")
          (alert "Invalid object <!>")
      )
      (progn
        (setq doc (vla-get-activedocument (vlax-get-acad-object)))
        (if
          (eq 4
              (logand
                4
                (cdr (assoc 70
                            (setq get (entget (tblobjname
                                                "LAYER"
                                                (cdr (assoc 8 (entget pck)))
                                              )
                                      )
                            )
                     )
                )
              )
          )
           (entmod (subst '(70 . 0) (setq lck (assoc 70 get)) get))
        )
        (vla-put-textstring (vlax-ename->vla-object pck) "%<\\AcVar Filename \\f \"%fn2\">%" )
        (if lck (entmod (subst lck (assoc 70 get) get)))
        (vla-regen doc acactiveviewport)
      )
 )
 (princ)
) (vl-load-com)

thanks for your great job

I have now started studying diesel and field. Your code is very helpful.

Usually in my work, I add unnecessary phrases to the file name.

such as revision no., date, or (updated) (working)..

so I add a command to apply only the necessary parts to the text.

by added a very small part of your lisp.

command

field_fullnamedwg = field name with .dwg extension.

field_fullname = same as original

field_customname = input start & end character number

field_fulldirectory = get full path

but i failed in field_parentdirectory = get parent directory name only.

since strlen works differently for each folder.

(defun c:field_fullnamedwg ( / a b )
 (setq a 1)
 (setq b 0)
 (sub:name a b)
 (princ)
)

(defun c:field_fullname ( / a b )
 (setq a 1)
 (setq b 4)
 (sub:name a b)
 (princ)
)

(defun c:field_customname ( / dwgname dwgnamelen a b )
 (setq dwgname (getvar 'dwgname))
 (setq dwgnamelen (strlen (getvar 'dwgname)))
 (princ "\n your full dwg name is = [ ")
 (princ dwgname)
 (princ " ]")
 (princ "\n total number of characters = ")
 (princ dwgnamelen)
 (setq a (getint "\n input start character number (from 1) = "))
 (setq b (- dwgnamelen (getint "\n input end character number (from 1) = ")))
 (sub:name a b)
 (princ)
)

(defun c:field_fulldirectory ( / a b )
 (setq a 1)
 (setq b 0)
 (sub:directory a b)
 (princ)
)


;| get parent directory only - failed 
(defun c:field_parentdirectory ( / fulldir fulldirlen fulldirlist fulldirlistlen strcount index atom del parentdir parentlen a b c)
 (setq fulldir (vl-princ-to-string (lm:unformat (getvar 'dwgprefix) nil)))
 (princ "\n fulldir - ")
 (princ fulldir)
 (setq fulldirlen (strlen fulldir))
 (princ "\n fulldir length - ")
 (princ fulldirlen)
 (setq fulldirlist (LM:str->lst fulldir "\\"))
 (princ "\n fulldirlist - ")
 (princ fulldirlist)
 (setq fulldirlistlen (length fulldirlist))
 (princ "\n fulldirlistlen - ")
 (princ fulldirlistlen)

 (setq strcount 0)
 (setq index 0)
 (setq atom 0)

 (repeat fulldirlistlen
   (setq atom (strlen (vl-princ-to-string (nth index fulldirlist))))
   (setq strcount (+ strcount atom))
   (setq index (+ index 1))
 );end of repeat

 (princ "\n total list strcount without deli = ")
 (princ strcount)

 (setq del (- fulldirlen strcount))
 (princ "\n delimiter count = ")
 (princ del)

 (setq parentdir (nth (- fulldirlistlen 2) fulldirlist))
 (princ "\n parent directory = ")
 (princ parentdir)

 (setq parentlen (strlen parentdir))
 ;(princ (substr (substr (getvar 'dwgprefix) (- (- (+ strcount fulldirlistlen) parentlen) 1) (+ parentlen 2)) 1 parentlen))
 (setq a (- (- (+ strcount fulldirlistlen) parentlen) 1))
 ;(setq a (- (- (- directorylen count) del) 1))
 (setq b 2)


 (sub:directory a b)

 (princ)
)

;; String to List  -  Lee Mac
;; Separates a string using a given delimiter
;; str - [str] String to process
;; del - [str] Delimiter by which to separate the string
;; Returns: [lst] List of strings
 
(defun LM:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

;by ronjonp https://www.theswamp.org/index.php?topic=44110.msg493609#msg493609
(defun _count (letter string)
  (length (vl-remove-if-not
            (function (lambda (x) (= (strcase letter) (strcase (chr x)))))
            (vl-string->list string)
          )
  )
)

|;


(vl-load-com)
(defun sub:name ( a b / doc pck lck get stringtopaste)
 ;;--------------------------------------------;;
 ;; 	Tharwat - Date: 13.Sep.2017		;;
 ;; Drawing name to field without extension	;;
 ;;--------------------------------------------;;
 (and (setq pck (car (nentsel "\nPick Text/Mtext/Attribute :")))
      (or (wcmatch (cdr (assoc 0 (entget pck))) "TEXT,MTEXT,ATTRIB")
          (alert "Invalid object <!>")
      )
      (progn
        (setq doc (vla-get-activedocument (vlax-get-acad-object)))
        (if
          (eq 4
              (logand
                4
                (cdr (assoc 70
                            (setq get (entget (tblobjname
                                                "LAYER"
                                                (cdr (assoc 8 (entget pck)))
                                              )
                                      )
                            )
                     )
                )
              )
          )
           (entmod (subst '(70 . 0) (setq lck (assoc 70 get)) get))
        )
        (setq stringtopaste (strcat "%<\\AcDiesel $(substr,$(getvar,\"dwgname\")," (vl-princ-to-string a) ",$(-,$(strlen,$(getvar,\"dwgname\"))," (vl-princ-to-string b) "))>%"))
        (vla-put-textstring (vlax-ename->vla-object pck) stringtopaste)
        (if lck (entmod (subst lck (assoc 70 get) get)))
        (vla-regen doc acactiveviewport)
      )
 )
 (princ)
) 

(defun sub:directory ( a b / doc pck lck get stringtopaste)
 ;;--------------------------------------------;;
 ;; 	Tharwat - Date: 13.Sep.2017		;;
 ;; Drawing name to field without extension	;;
 ;;--------------------------------------------;;
 (and (setq pck (car (nentsel "\nPick Text/Mtext/Attribute :")))
      (or (wcmatch (cdr (assoc 0 (entget pck))) "TEXT,MTEXT,ATTRIB")
          (alert "Invalid object <!>")
      )
      (progn
        (setq doc (vla-get-activedocument (vlax-get-acad-object)))
        (if
          (eq 4
              (logand
                4
                (cdr (assoc 70
                            (setq get (entget (tblobjname
                                                "LAYER"
                                                (cdr (assoc 8 (entget pck)))
                                              )
                                      )
                            )
                     )
                )
              )
          )
           (entmod (subst '(70 . 0) (setq lck (assoc 70 get)) get))
        )

        (setq stringtopaste (strcat "%<\\AcDiesel $(substr,$(getvar,\"dwgprefix\")," (vl-princ-to-string a) ",$(-,$(strlen,$(getvar,\"dwgprefix\"))," (vl-princ-to-string b) "))>%"))
        (vla-put-textstring (vlax-ename->vla-object pck) stringtopaste)
        (if lck (entmod (subst lck (assoc 70 get) get)))
        (vla-regen doc acactiveviewport)
      )
 )
 (princ)
)

April 28, 2022

Thank you.

This should give you the Path only.

(vla-put-textstring (vlax-ename->vla-object pck) "%<\\AcVar Filename \\f \"%tc4%fn1\">%")

Sign In

Filename in Field Form

Recommended Posts

CAD_Noob

Lee Mac

CAD_Noob

BIGAL

CAD_Noob

Tharwat

CAD_Noob

Tharwat

CAD_Noob

Tharwat

CAD_Noob

exceed

Tharwat

Join the conversation

Tutorials

Forums

Activity