Leaderboard

@Truski ATTIN - ATTOUT

It is not a overnight learning process but Google is your friend, there are many forums out there with a Lisp section and you will find so many examples to learn from. When googling ask question and add "Autocad Lisp" eg "export attributes to excel autocad lisp" I like many others support people having a go at coding rather than "do this for me". Avoid CHATGP as its not up to scratch and produces a lot of incorrect code. There are a lot of books out there also and these days are electronic so can copy code, I have books from Kindle very cheap.

Cool, I saved this one. I just added a couple lines for settings. @cooldude224 My edit should help you with the position of the attribute (defun c:add_ATT (/ ss blk blk-lst atts-lst def AttObj obj2 text_height ip mode align) ;; settings. Feel free to adapt to your needs. ;; Feel free to change the settings from hard coded to user input. See below (setq text_height 2.5) (setq ip (list 0.0 0.0)) ;; insert point in the block (setq default_value "") ;; MODE: ;; (any combination of constants can be used by adding them together): ;; acAttributeModeNormal ;; acAttributeModeInvisible ;; acAttributeModeConstant ;; acAttributeModeVerify ;; acAttributeModePreset (setq mode acAttributeModeNormal) ;; Allignment: ;; acAlignmentLeft / acAlignmentCenter / acAlignmentRight / acAlignmentAligned / acAlignmentMiddle / acAlignmentFit / acAlignmentTopLeft / acAlignmentTopCenter / acAlignmentTopRight / acAlignmentMiddleLeft / acAlignmentMiddleCenter / acAlignmentMiddleRight / acAlignmentBottomLeft / acAlignmentBottomCenter / acAlignmentBottomRight (setq align acAlignmentRight) ;; COMMENT OUT THESE NEXT LINES IF YOU WANT THE HARD CODED SETTINGS (setq text_height (getdist "\nText height: ")) (setq ip (getpoint "\nInsert point: ")) (setq default_value (getstring "\nDefault value: " T)) (vl-load-com) (setq Tag (strcase (getstring "\nSpecify attribute tag: "))) (if (setq ss (ssget '((0 . "INSERT")))) ;change if to while repeats command if you keep selecting things (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex SS))) ;makes a list of all entitys by ename in selection set and steps thought them one at a time (setq blk (cdr (assoc 2 (entget e)))) (if (not (vl-position blk blk-lst)) (progn (setq blk-lst (cons blk blk-lst)) (setq obj2 (vlax-ename->vla-object e)) (setq atts-lst nil) ;clear list from last use (if (= (vla-get-hasattributes obj2) :vlax-true) (foreach att (vlax-invoke obj2 'getattributes) (setq atts-lst (cons (strcase (vla-get-tagstring att)) atts-lst)) ;make a list of all Attributs tag names to check rather then checking them all individually ) ;;close foreach ) ;;close if (if (not (member tag atts-lst)) ;checks list for "SYSTEM" could also use vl-position (progn (setq def (vla-item (vla-get-blocks (vla-get-activedocument (vlax-get-acad-object))) blk)) ;; VL : RetVal = (vla-AddAtribute object Height Mode Prompt InsertionPoint Tag Value) (setq AttObj (vla-addattribute def text_height mode "" (vlax-3D-point ip) TAG default_value)) (vlax-put AttObj 'Alignment align) (vla-move AttObj (vlax-3D-point (list 0.0 0.0)) (vlax-3D-point ip)) (command "_.attsync" "_N" blk) ) ;;close progn ) ;;close if ) ;;close progn ) ;;close if ) ;;close foreach ) ;;close if (princ) )

Have you tried yet with the same technique? Your responses seem to show you have had no instruction with AutoCAD and are floundering. Is it really your metier?

That's fine, but I am just trying to educate you. The (opendwg) is a function, not a command. You have to use it inside a command (defun C:...), or directly in a macro like this: ;; OPENDWG ;; Argument: dwg = string; the full path and file name of the drawing, ;; or just the file name if in the search path. (defun opendwg (dwg) (vl-load-com) (vla-open (vla-get-activedocument (vlax-get-acad-object)) dwg) ) (defun c:Openit () (opendwg "C:\\Users\\Username\\Drawings24\\Office3.dwg") ) AND this in a macro: ^C^COpenit OR this directly: ^C^C(opendwg "C:\\Users\\Username\\Drawings24\\Office3.dwg")

@Kiko Thanks - I am glad it worked for you! FYI - just because an author gives you code does not mean that you have permission to edit it, redistributed it, etc. Many Authors give their code freely here, but some also expect that the code remain unaltered, and with original comments and authorship intact unless they give expressed permission to do so. I have learned that from experience.

I might write the function in the following way - by obtaining the text content from the DXF data, non-ASCII characters are retained, but the new content is easier populated using ActiveX: (defun c:rxfind ( / *error* ent fnd idx new rep rgx sel str ) (defun *error* ( msg ) (if (and (= 'vla-object (type rgx)) (not (vlax-object-released-p rgx))) (vlax-release-object rgx) ) (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))) (princ (strcat "\nError: " msg)) ) (princ) ) (cond ( (= "" (setq fnd (getstring t "\nSpecify RegEx find pattern <exit>: ")))) ( (not (setq rep (getstring t "\nSpecify RegEx replace pattern <blank>: ") sel (LM:ssget "\nSelect text, mtext or multileaders: " '("_:L" ((0 . "TEXT,MTEXT,MULTILEADER")))) ) ) (princ "\n*Cancel*") ) ( (or (not (setq rgx (vl-catch-all-apply 'vlax-create-object '("vbscript.regexp")))) (vl-catch-all-error-p rgx) ) (princ "\nUnable to interface with Regular Expressions object.") ) ( t (vlax-put-property rgx 'pattern fnd) (vlax-put-property rgx 'global actrue) (vlax-put-property rgx 'multiline actrue) (vlax-put-property rgx 'ignorecase actrue) ;; Change this to suit (repeat (setq idx (sslength sel)) (setq idx (1- idx) ent (ssname sel idx) ) (if (and (setq str (LM:gettextstring ent)) (setq new (vlax-invoke rgx 'replace str rep)) (/= str new) ) (vla-put-textstring (vlax-ename->vla-object ent) new) ) ) ) ) (*error* nil) (princ) ) ;; ssget - Lee Mac ;; A wrapper for the ssget function to permit the use of a custom selection prompt ;; msg - [str] selection prompt ;; arg - [lst] list of ssget arguments (defun LM:ssget ( msg arg / sel ) (princ msg) (setvar 'nomutt 1) (setq sel (vl-catch-all-apply 'ssget arg)) (setvar 'nomutt 0) (if (not (vl-catch-all-error-p sel)) sel) ) ;; Get Textstring - Lee Mac ;; Returns the text content of Text, MText, Multileaders, Dimensions & Attributes (defun LM:gettextstring ( ent / enx itm str typ ) (setq enx (reverse (entget ent)) typ (cdr (assoc 0 enx)) ) (cond ( (wcmatch typ "TEXT,*DIMENSION") (cdr (assoc 1 enx)) ) ( (and (= "MULTILEADER" typ) (= acmtextcontent (cdr (assoc 172 enx))) ) (cdr (assoc 304 (reverse enx))) ) ( (wcmatch typ "ATTRIB,MTEXT") (setq str (cdr (assoc 1 enx))) (while (setq itm (assoc 3 enx)) (setq str (strcat (cdr itm) str) enx (cdr (member itm enx)) ) ) str ) ) ) (vl-load-com) (princ) I'm unsure why you were using "." for whitespace - you can simply enter a space at the getstring prompt.

ye thanks a lot

Halsy is happy with Steven's Lisp, so I came returned too late to this party. Anyway, here is my version. It is pretty close to my previously posted program but now it searches for the sequence "space-something-space". Also I extended it a bit to process Mtexts as well. Here it is: (defun c:pp() (setq ss (ssget '((0 . "*TEXT")))) (repeat (setq i (sslength ss)) (setq el (entget (ssname ss (setq i (1- i)))) txt1 (cdr (assoc 1 el)) pos1 (1+ (vl-string-search " " txt1 1)) pos2 (1+ (vl-string-search " " txt1 (1+ pos1))) pos3 (strlen txt1) txt2 (strcat (substr txt1 (+ pos2 1)) (substr txt1 pos1 (- pos2 pos1 -1)) (substr txt1 1 pos1)) el (subst (cons 1 txt2) (assoc 1 el) el) el (entmod el)) ) )

thanks guys. cheers!

A question not asked, do you want always longer length first so 1200 x 600 does not change.

If you know the name of the dwg why go through all the merry go round stuff. Just open the correct dwg, put in say a menu or use tool palettes, ^c^COpen "C:\\Users\\Username\\Drawings24\\Office3.dwg" Need " if dwg name has spaces else not required and can use a single "\".

There are tons of resources out there. Here are some links to get you started (not in order of complexity): https://www.cadtutor.net/tutorials/autolisp/quick-start.php https://www.lee-mac.com/tutorials.html https://lispexpert.blogspot.com/p/blog-page_16.html https://www.afralisp.net/autolisp/tutorials/index.php?category_id=1 https://www.jefferypsanders.com/autolisptut.html https://blog.draftsperson.net/good-autolisp-programming-techniques/ https://autolispcourse.com/category/tutorials/

@DELLA MAGGIORA YANN Hint - comment out at the end of the routine using semi-colons like below: ;; now offset all plines ; (foreach pline plines ; ; Offset the polyline ; (if pline ; (progn ; (vla-StartUndoMark acdoc) ; Start an undo mark ; (vla-get-ActiveDocument (vlax-get-acad-object)) ; (vla-offset pline 0.8) ; Offset the polyline by 0.3 units ; (vla-EndUndoMark acdoc) ; End the undo mark ; ) ; ) ; ) ) ; DONT comment in front of this line ; (C:Region2Polyline2) comment in front of this line to stop it from running when loaded. Note - it is considered rude among this forum to just ask for free help without attempting to learn at least some basics about AutoLISP / Visual LISP. Thanks why most here will try to guide you through rather then just updating it for you.

Thank you! ATTREQ worked perfectly I knew it had to be something so simple that I just could not figure out without some help. thanks again. SLW210

Does the 'X' change? So in your example D, B1, B3 ? and is there always a space either side of that? LISPs work really well if there is a rule that you can apply but got to work out the rule, and need all the information. Fuccaro works according to your first post with an 'X' in the middle. For Fuccaros code to work well for every circumstance we'll need to know whatever is in between the numbers for every instance.

I guess that in that case, you don't need offset at all... Quickly written, and untested... (defun c:maketextreadable ( / _aap l lines p2 ss text dxf50 xx minp maxp mp pp d ) (vl-load-com) ;; RJP » 2021-10-06 ;; MR » 2021-01-11 (defun _aap (ename pt / param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq param (vlax-curve-getparamatpoint ename pt)) ) (angle '(0 0) (vlax-curve-getfirstderiv ename param)) ) ) (if (= 8 (logand 8 (getvar 'undoctl))) (vl-cmdf "_.UNDO" "_E") ) (vl-cmdf "_.UNDO" "_M") (if (setq ss (ssget '((0 . "*polyline,Line,*Text")))) (progn (or (setq d (getdist "\nEnter offset distance <0> : ")) (setq d 0)) (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (and (wcmatch (cdr (assoc 0 (setq xx (entget x)))) "*TEXT") (/= 4 (logand 4 (cdr (assoc 70 (tblsearch "LAYER" (cdr (assoc 8 xx)))))))) (setq text (cons x text)) (if (not (wcmatch (cdr (assoc 0 xx)) "*TEXT")) (setq lines (cons x lines)) ) ) ) (if lines (foreach x text (vla-getboundingbox (vlax-ename->vla-object x) 'minp 'maxp) (mapcar 'set '(minp maxp) (mapcar 'safearray-value (list minp maxp))) (setq mp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) minp maxp)) (setq l (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x mp)) (distance mp p2) (_aap x p2)) ) lines ) ) (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) ;; Check that we have an angle assigned (if (caddr l) (progn (setq dxf50 ((lambda (x) (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x ) ) (caddr l) ) ) (entupd (cdr (assoc -1 (entmod (subst (cons 50 dxf50) (assoc 50 (setq xx (entget x))) xx))))) (vla-getboundingbox (vlax-ename->vla-object x) 'minp 'maxp) (mapcar 'set '(minp maxp) (mapcar 'safearray-value (list minp maxp))) (setq pp (mapcar '(lambda (a b) (/ (+ a b) 2.0)) minp maxp)) (vla-move (vlax-ename->vla-object x) (vlax-3d-point pp) (vlax-3d-point mp)) (vla-move (vlax-ename->vla-object x) (vlax-3d-point mp) (vlax-3d-point (car l))) (vla-move (vlax-ename->vla-object x) (vlax-3d-point (car l)) (vlax-3d-point (polar (car l) (angle (car l) mp) d))) ) ) ) ) ) ) (vl-cmdf "_.UNDO" "_E") (princ) )

Give this version a try: (defun c:foo (/ _aap a d l lines p p2 ss text x) ;; RJP » 2021-10-06 (defun _aap (ename pt / param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq param (vlax-curve-getparamatpoint ename pt)) ) (angle '(0 0) (vlax-curve-getfirstderiv ename param)) ) ) (if (setq ss (ssget '((0 . "*polyline,Line,*Text")))) (progn (or (setq d (getdist "\nEnter offset distance:<0> ")) (setq d 0)) (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (wcmatch (cdr (assoc 0 (entget x))) "*TEXT") (setq text (cons x text)) (setq lines (cons x lines)) ) ) (if lines (foreach x text (setq p (cdr (assoc 10 (entget x)))) (setq l (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2)) ) lines ) ) (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) ;; Check that we have an angle assigned (if (caddr l) (progn (entmod (subst (cons 50 ((lambda (x) (setq a (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x ) ) ) (caddr l) ) ) (assoc 50 (entget x)) (entget x) ) ) ) ) ; <--- Modified by Jonathan Handojo ;; RJP added offset (entmod (subst (cons 10 (polar (car l) (+ (/ pi 2) a) d)) (assoc 10 (entget x)) (entget x)) ) ; <--- Line added by Jonathan Handojo ) ) ) ) (princ) )

For mtext: ;; Change this (setq ss (ssget '((0 . "*polyline,Line,Text")))) ;; to this (setq ss (ssget '((0 . "*polyline,Line,*Text")))) ;; and this (if (= "TEXT" (cdr (assoc 0 (entget x)))) ;; to this (if (wcmatch (cdr (assoc 0 (entget x))) "*TEXT")

Try this .. it was bonking out because the _aap function was returning nil. (defun c:foo (/ _aap l lines p p2 ss text) ;; RJP - 6.14.2017 (defun _aap (ename pt / param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq param (vlax-curve-getparamatpoint ename pt)) ) (angle '(0 0) (vlax-curve-getfirstderiv ename param)) ) ) (if (setq ss (ssget '((0 . "*polyline,Line,Text")))) (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (= "TEXT" (cdr (assoc 0 (entget x)))) (setq text (cons x text)) (setq lines (cons x lines)) ) ) (if lines (foreach x text (setq p (cdr (assoc 10 (entget x)))) (setq l (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2)) ) lines ) ) (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) ;; Check that we have an angle assigned (if (caddr l) (progn (entmod (subst (cons 50 ((lambda (x) (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x ) ) (caddr l) ) ) (assoc 50 (entget x)) (entget x) ) ) ) ) ; <--- Modified by Jonathan Handojo (entmod (subst (cons 10 (car l)) (assoc 10 (entget x)) (entget x))) ; <--- Line added by Jonathan Handojo ) ) ) ) (princ) )

Initially this post was meant to only rotate the text to the nearest polyline, so this forum is out of your request. For your case, I modified two lines from ronjonp's code. it should give you the desired result. (defun c:foo (/ _aap l lines p p2 ss text) ;; RJP - 6.14.2017 (defun _aap (ename pt / param) (if (and (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list ename)))) (setq param (vlax-curve-getparamatpoint ename pt)) ) (angle '(0 0) (vlax-curve-getfirstderiv ename param)) ) ) (if (setq ss (ssget '((0 . "*polyline,Line,Text")))) (progn (foreach x (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (if (= "TEXT" (cdr (assoc 0 (entget x)))) (setq text (cons x text)) (setq lines (cons x lines)) ) ) (if lines (foreach x text (setq p (cdr (assoc 10 (entget x)))) (setq l (mapcar '(lambda (x) (list (setq p2 (vlax-curve-getclosestpointto x p)) (distance p p2) (_aap x p2)) ) lines ) ) (setq l (car (vl-sort l '(lambda (a b) (< (cadr a) (cadr b)))))) (entmod (subst (cons 50 ((lambda (x) (if (<= (* 0.5 pi) x (* 1.5 pi)) (+ x pi) x)) (caddr l))) (assoc 50 (entget x)) (entget x))) ; <--- Modified by Jonathan Handojo (entmod (subst (cons 10 (car l)) (assoc 10 (entget x)) (entget x))) ; <--- Line added by Jonathan Handojo ) ) ) ) (princ) )