Request For Assistance In Editing Texts

[mehrdad]

Thank you very much for your time. If this is the image you're referring to, it still doesn't display the date as 01-10-24, nor does it recognize the HTX1 text style. Yes, they have been processed within the model environment. To avoid any potential errors on my part, could you please provide me with the final file? Thank you very much.

[mehrdad]

.

Edited October 1 by mehrdad

[mehrdad]

Thank you very much for your time. If this is the image you're referring to, it still doesn't display the date as 01-10-24, nor does it recognize the HTX1 text style. Yes, they have been processed within the model environment. To avoid any potential errors on my part, could you please provide me with the final file? Thank you very much.

[rlx]

thanx for stepping in Steven , have to finish something for the boss before the end of the day... 

the second (now) function I've posted replaces the old one. You can either first remove de old defun from the original post , or put the new defun at the end of the isp file. When loaded , the last found defun will be used so if the new one is inserted before the old one , only the old one will be excuted.

 

you could try to replace the old addtext_dbx defun with this :

(defun addtext_dbx (d s p h / o a)
  (setq o (vla-AddText (vla-get-ModelSpace d) s (vlax-3d-point p) h))
  (vla-put-textstyle o "HTX1")
)

 

but not sure if this will work in odbx. In that case maybe going the old school script is gonna be better

[Steven P]

For text height (size) and style replace the lines as below:

 

;;Replace:
(setq Old_Font (getvar 'textstyle) )
(setvar 'textstyle "HTX1")

;;With:
(setq vars '("textstyle" "textsize"))
(setq Old_Font (mapcar 'getvar vars)) ;;get old variables
(mapcar 'setvar vars '("HTX1" 3.125)) ;;set variables to new


;;and replace:
(setvar 'textstyle Old_Font)

;;With
(mapcar 'setvar vars Old_Font)

 

[rlx]

@Steven P I use (setq y (nth 1 y-list)) , where the 1 stands for the row (D1). The Y coordinate for each row is in y-list so that way its easy to pick another row , just by changing 1 into 2 for row D2 for example. Could be a nice radio-row or column

[Steven P]

If only there was a handy radio button LISP out there.. yes a radio button might be a nice interface.

 

Not a problem to look at this - a few changes and perhaps give the OP some confidence to look at the code and make a few changes rather than give a polished solution

[mehrdad]

Thank you once again for your time on this matter. Unfortunately, the issue persists. As you can see in the image...

 

[Steven P]

Yes, the font style is being carried over in the batch process, will have a think over lunch

[rlx]

yeah I think that style must exist in drawing before you can use it. Probably have to do an add / create text style first before you can assign it. Will have a look tonight if Steven doesn't beat me to it.

[mehrdad]

I am extremely grateful to both of you for your time and assistance.

[rlx]

;;; rlx 2024-10-01 - https://www.cadtutor.net/forum/topic/91692-request-for-assistance-in-editing-texts/
(defun c:Mehrdad ( / doc actLay actDoc actDocs actApp actDbx AllOpen dir lst x-list y-list y z save data)
  (vl-load-com)
  (setq x-list (list 252.0 280.0 360.0 375.0 388.0) y-list (list 26.5 33.0 39.5 46.0 52.5 59.0 65.5) z 0.0)
   ;;; if you another date , change line to something like (setq date "01-02-25")
  (setq date (now))
  
  (setq s-list (list date "APPROVED FOR CONSTRUCTION" "R.S" "A.SH" "A.SH"))
 
  
  ;;; set y coordinate for row D1
  (setq y (nth 1 y-list))
  (if (and (setq dir (GetShellFolder "Select Folder")) (vl-consp (setq lst (alldrawings dir))))
    (foreach dwg lst
      (if (setq doc (odbx_open dwg))
        (progn
          (mapcar '(lambda (txt x) (addtext_dbx doc txt (list x y z) 3.125)) s-list x-list)
          (if (vl-catch-all-error-p (setq save (vl-catch-all-apply 'vla-saveas (list doc dwg))))
            (alert (strcat  "Save error: "
             (vl-catch-all-error-message save) "\ndrawing : " (vl-princ-to-string dwg))))
        )
        (princ (strcat "\nUnable to open : " dwg))
      )
    )
  )
  (_ReleaseAll)
  (princ "\nDone.")
  (princ)
)

;;; --- Odbx ---------------------------------------------- Begin Odbx Section ----------------------------------------------- Odbx --- ;;;

(defun GetAllOpenDocs ()
  (or actApp (setq actApp (vlax-get-acad-object))) (or actDoc (setq actDoc (vla-get-ActiveDocument actApp)))
    (or actDocs (setq actDocs (vla-get-documents actApp)))
  (vlax-for doc actDocs (if (= 1 (vlax-variant-value (vla-getvariable doc "DWGTITLED"))); no nameless drawings
    (setq AllOpen (cons (cons (strcase (vla-get-fullname doc)) doc) AllOpen))))
)

(defun _ReleaseAll ()
  (mapcar '(lambda(x) (if (and (= 'vla-object (type x)) (not (vlax-object-released-p x)))
    (vlax-release-object x))(set x nil)) (list 'doc 'actLay 'actDoc 'actDocs 'actApp 'actDbx))(gc))

(defun _InitObjectDBX ()(or actApp (setq actApp (vlax-get-acad-object)))
  (or actDoc (setq actDoc (vla-get-ActiveDocument actApp)))(or AllOpen (setq AllOpen (GetAllOpenDocs)))
  (setq actDbx (vl-catch-all-apply 'vla-getinterfaceobject (list actApp (dbx_ver))))
  (if (or (null actDbx)(vl-catch-all-error-p actDbx))(progn (princ "\nObjectDbx not available")(setq actDbx nil)))
  actDbx
)

(defun odbx_open ( $dwg / _pimp doc) (or AllOpen (GetAllOpenDocs))
  (defun _pimp (s) (strcase (vl-string-trim " ;\\" (vl-string-translate "/" "\\" s))))
  (cond ((or (void $dwg) (not (findfile $dwg)))(princ "\nInvalid drawing")(setq doc nil))
	((not (or actDbx (_InitObjectDBX)))(princ "\nObjectDbx not available")(setq doc nil))
        ((setq doc (cdr (assoc (_pimp $dwg) AllOpen))))
	((vl-catch-all-error-p (vl-catch-all-apply 'vla-Open (list actDbx (findfile $dwg))))
	 (princ "\nUnable to open drawing.")(setq doc nil))
	(t (setq doc actDbx)))
  doc
)

(defun odbx_close ( %doc ) (if (and (= 'vla-object (type %doc))
  (not (vlax-object-released-p %doc)))(progn (vlax-release-object %doc))(setq %doc nil)))

(defun dbx_ver ( / v) (strcat "objectdbx.axdbdocument" (if (< (setq v (atoi (getvar 'acadver))) 16) "" (strcat "." (itoa v)))))

;;; --- Odbx ---------------------------------------------- End Odbx Section ------------------------------------------------- Odbx --- ;;;



;;; --- Tiny Lisp ---------------------------------------- Begin of Tiny Lisp ------------------------------------------- Tiny Lisp --- ;;;

; generic getfolder routine with possibility to create a new subfolder (GetShellFolder "select path")
(defun GetShellFolder ( m / f s) (if (and (setq s (vlax-create-object "Shell.Application"))
  (setq f (vlax-invoke s 'browseforfolder 0 m 65536 "")))(setq f (vlax-get-property (vlax-get-property f 'self) 'path))
     (setq f nil))(vl-catch-all-apply 'vlax-release-object (list s))
  (if f (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" f)) "\\")))

;;; (getsubfolders "c:/temp/lisp")
(defun getsubfolders ( d / l r s )(setq d (Dos_Path d))(setq l (list (vl-string-trim "/\\" d)))(while l (setq s nil)
  (foreach d l (setq s (append s (mapcar (function (lambda (x)(strcat d "\\" x))) (vl-remove-if (function
    (lambda (x)(member x '("." ".."))))(vl-directory-files d nil -1)))))) (setq r (append s r) l s))
  (cons d (mapcar 'Dos_Path r))
)

(defun Dos_Path ($p) (if (= (type $p) 'STR)
  (strcase (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" $p)) "\\")) ""))

(defun alldrawings ( d / s l r) (setq l (mapcar 'Dos_Path (getsubfolders d)))
  (foreach s l (setq r (append r (mapcar '(lambda (x)(strcat s x))(vl-directory-files s "*.dwg" 1))))) r)

;;; s = string , p = insertion point , h = text height
(defun addtext_dbx (d s p h / o a) (setq o (vla-AddText (vla-get-ModelSpace d) s (vlax-3d-point p) h)))

;;; s = string , p = insertion point , h = text height
(defun addtext_dbx (d s p h / o a stls)
  (addTextStyle_dbx d "HTX1" "arial.ttf")
  (setq o (vla-AddText (vla-get-ModelSpace d) s (vlax-3d-point p) h))
  (vla-put-StyleName o "HTX1")
  ;;; just optional for easy viewing
  (vla-put-color o acRed)
)

(defun addTextStyle_dbx (doc stl fnt / styles style stl-obj Fnt-Ext)
  (setq styles (vla-get-textstyles doc))
  (if (vl-catch-all-error-p (setq style (vl-catch-all-apply 'vla-item (list styles stl))))
    (setq stl-obj (vla-add styles style)) (setq stl-obj style))
  (setq Fnt-Ext (vl-filename-extension fnt))
  (if (= Fnt-Ext ".ttf")(setq fnt (strcat "C:\\Windows\\Fonts\\" fnt)))
  (setq fnt (findfile fnt))
  (vla-put-fontfile stl-obj fnt)
)

;;; "01-10-24"
(defun now ( / ns) (setq ns (rtos (getvar "CDATE")) ns (strcat (substr ns 7 2) "-" (substr ns 5 2) "-" (substr ns 3 2))))

(defun void (x) (or (eq x nil) (and (listp x)(not (vl-consp x))) (and (eq 'STR (type x)) (eq "" (vl-string-trim " \t\r\n" x)))))

;;; --- Tiny Lisp ---------------------------------------- Begin of Tiny Lisp ------------------------------------------- Tiny Lisp --- ;;;

(c:Mehrdad)

 

[Steven P]

Nice, I struggled with this one - set off on the wrong path I think and then round in circles.... 

[rlx]

I struggled with the text style for a moment , only to find I tried to use the wrong command. The right command being vla-put-StyleName.

We don't always have a choise what material we have do deal with , AutoCad dwg's , tiff , pdf , vectorized... but if these drawings would want to live in my document control system I'd probably replace border & titleblock for a real titleblock. But I understand , sometimes its not economic to do so.

[mehrdad]

Greetings to you all. This is working exceptionally well. Thank you very much, and a special thank you to Mr. Steven P. and the rest of the team.

[BIGAL]

I am glad others stepped in and helped you out. 

 

It may be worthwhile still looking at using a Revision Title block rather than individual text.  The image shows where you would have attributes they could have a default value like "." or "-", even just leave blank.

 

Multiple advantages, does not matter where it is located re X&Y, can be found by name, can change any attribute by tag name.

 

It is possible to convert your existing dwg's adding the Revision title block and read the current text, placing it into correct attribute, if that sounds promising let me know.

 

 

Edited October 2 by BIGAL