Jump to content

Leaderboard

Popular Content

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

  1. This should change all block definitions to scale uniformly. (defun c:foo nil (vlax-for b (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) (and (= 0 (vlax-get b 'isxref) (vlax-get b 'islayout)) (vl-catch-all-apply 'vla-put-blockscaling (list b acuniform)) ) ) (princ) )
    2 points
  2. Is this what you are trying to do? Have a block with a field that updates as you move the block? The block can be a simple rectangle with a point and attribute - the point doesn't have to lie on the rectangle perimeter to allow the text / rectangle to be offset. To entmake or entmakex the field you create an mtext object with the text string being the field definition - which you might get from following this link: https://www.autodesk.com/support/technical/article/caas/sfdcarticles/sfdcarticles/How-to-add-x-y-coordinates-to-block-attribute-in-AutoCAD.html#:~:text=Create a block with x,y coordinates as
    1 point
  3. 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.
    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. Can you post some sample of chevron shapes, I know can be single solid left or right and a "V" as per image, the enclosing shape is the issue.
    1 point
×
×
  • Create New...