Jump to content

Leaderboard

Popular Content

Showing content with the highest reputation on 10/01/2024 in all areas

  1. 1 point
  2. 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.
    1 point
  3. 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.
    1 point
  4. ;;; 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)
    1 point
  5. 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.
    1 point
  6. @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
    1 point
  7. 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
    1 point
  8. (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 want to preset 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) ) ;;; "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))))
    1 point
  9. I ran it without any probems , just saved your drawing 3 times for testing oh darn , the void thing , I checked if I used it here but guess I overlooked it , my bad : (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))))) you may want to change line 5 , the line with s-list , didn't know who APP'd it so I used "RLX" but you probably wish to put another name here
    1 point
  10. Ok my answer, the simplest way around this but its a fix for future is make a title block or blocks, you could have a revision block ie D01 D02 etc, you would have attributes much easier to find and update. With a revision block you can do stuff like "add revision" it finds last entry then goes 1 above asking for details. Ok the answer to your question is you can get text at a XY position and replace, the issue is if one of your dwg's is offset it may find wrong text. You need to use "fence" to find the text. (setq pts (list (list 252 34)(list 278 34))) (setq txt (ssget "f" pts)) Have you thought about making a single dwg with 200 layouts ? Makes stuff like plotting, sheet numbering much easier. Yes can copy from another dwg and insert into a new layout. I like others have lots of lisp's based around this approach including make Index. I would find all the rev details and put in a rev blocka s first fix. Would that be helpful ?
    1 point
×
×
  • Create New...