Jump to content

Filename in Field Form

CAD_Noob

By CAD_Noob
in AutoLISP, Visual LISP & DCL

 Share

Recommended Posts

CAD_Noob Collaborator

CAD_Noob

Posted
Posted

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?

Link to comment
Share on other sites
Lee Mac Grand Master

Lee Mac

Posted
Posted

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.

Link to comment
Share on other sites
CAD_Noob Collaborator

CAD_Noob

Posted
  • Author
Posted
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))

Link to comment
Share on other sites
BIGAL Grand Master

BIGAL

Posted
Posted

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)>%")

Link to comment
Share on other sites
CAD_Noob Collaborator

CAD_Noob

Posted
  • Author
Posted
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

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted

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)

Link to comment
Share on other sites
CAD_Noob Collaborator

CAD_Noob

Posted
  • Author
Posted
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

Link to comment
Share on other sites
Tharwat Grand Master

Tharwat

Posted
Posted
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)

  • Thanks 1
Link to comment
Share on other sites
CAD_Noob Collaborator

CAD_Noob

Posted
  • Author
Posted
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.

Link to comment
Share on other sites
  • 4 years later...
exceed Proficient

exceed

Posted
Posted
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)
)

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 Share
Go to topic listing
×
×
  • Create New...