Leaderboard

A couple of loose ends to tie up the all-too-fast V.2 release: -Multiple renumbering is currently done based on the order of the objects in the database: this looks ugly if the dispersion is too random. -As PGia has suggested, perhaps I should leave a brief explanation of the code's functionality. So, let's get to it: I've added a couple of improvements to the code that makes up the new version of <<Something different>>, which I've attached below. What's New in Version 2.1 The philosophy of this command is to concentrate the greatest number of functions in the fewest user actions. In addition to the previous capabilities: - individual creation/renumbering of texts based on the cursor position - multiple renumbering of texts using a selection window, thanks to the momentary activation of the 'V' key... The following has been added: - readjustment of the renumbering criteria for multiple texts ('V' key option): from now on, renumbering will be done based on proximity to the first corner indicated on the screen of the selection window. That is, if the selection window is from Northwest to Southwest, the renumbering increment will be in order from least to greatest distance from the Northwest corner. - In addition, the definition of the real-time selection window is discontinuous to differentiate it from others. ;******* <<S o m e t h i n g d i f f e r e n t V.2.1>> ******* ;******************* p o r d e s í a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:txtIncrem (/ tam capa ind para a c cl txsel le l s dameTexto uconfig obtcad ent loc tipC nC ps add errores error0 v actTX ventanea pv n cj acdoc md listOrda pr lt f ) (defun errores (mens) (setq *error* error0) (while (>= (boole 1 (getvar "UNDOCTL") 8) 8) (vla-endundomark acdoc) ) (prin1) ) (defun dameTexto (cad / v r l daleVuelta) ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE (defun daleVuelta (a) (cond ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a)) ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a)) ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a)) ) ) (foreach v (reverse (vl-string->list cad)) (if (or (not r) (minusp r)) (setq l (cons (abs (setq r (daleVuelta v))) l)) (setq l (cons v l)) ) ) (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l)) ) (defun ventanea (/ p no se) (if (listp (setq p (cadr l))) (progn (redraw) (grvecs (list -7 pv (setq no (list (car pv) (cadr p))))) (grvecs (list -7 pv (setq se (list (car p) (cadr pv))))) (grvecs (list -7 no p)) (grvecs (list -7 se p)) ) ) ) (defun actTX (e / le) (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget e))) le)) (setq tx (dameTexto tx)) nil ) (defun listOrda (cj pr / e n l) (vl-sort (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (setq l (cons (list (cdr (assoc 10 (entget e))) e) l)) ) '(lambda (a b) (< (distance pr (car a)) (distance pr (car b))) ) ) ) (setq error0 *error* *error* errores ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (while (>= (boole 1 (getvar "UNDOCTL") 8) 8) (vla-endundomark acdoc) ) (princ (setq s "Select PREVIOUS number text or type it... ")) (while (not para) (setq l (grread T 13 2)) (if (not (listp (cadr l))) (if (member (car l) '(2 3 11 25)) (cond ((or (= (cadr l) 13) (= (car l) 25) (= (car l) 11)) (if (and c (not (wcmatch c "*.*"))) (setq ind c para T) (if (not c) (setq para T)) ) ) ((> (cadr l) 31) (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l)))) (prompt (strcat "\r" s c)) ) ((= (cadr l) 8) (if (setq c (if c (substr c 1 (- (strlen c) 1)))) (prompt (strcat "\r" s c)) ) ) (T (princ) ) ) ) (if (= (car l) 3) (if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT")) (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*")) (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T) (princ "\n*** The selected object is not valid. Please, try again... ***") ) ) ) ) ) (setq para nil) (if (not capa) (while (not para) (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... "))) (setq l (entget e)) ) (if (= (cdr (assoc 0 l)) "TEXT") (setq capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T) (princ "\n*** The selected object is not a TEXT. Please, try again... ***") ) (if (not capa) (if (setq capa (getstring "\nType Layer name: ")) (if (tblsearch "layer" capa) (if (not (setq a (getreal "\nType Height: "))) (setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil) (setq para T) ) (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil) ) ) ) ) ) ) (setq tx (dameTexto ind) s nil) (while ;(and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3 2))) (and (setq l (grread T (cond (s 4) (v 4) (T 13)) (cond (s 2) ((and pv v) 1) (v 2) (T 0)))) (member (car l) '(5 3 2))) (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (<V> for ON/OFF multiple selection or <RIGHT CLICK> for exit)")) (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil n nil) (if (= (car l) 2) (cond ((member (cadr l) '(86 118)) (setq v (not v)) ) ;;; HERE MORE CASES ?...(ascii "V") ) (if (or v (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam)) (list (+ (car p) tam) (+ (cadr p) tam)) (list (cons 0 "TEXT")) ) ) ) (cond ((= (car l) 3) (if s (setq md (vla-startundomark acdoc) s (actTX (ssname s 0))) (if pv (if (setq cj (ssget "_C" pv (cadr l) (list (cons 0 "TEXT"))) lt (if cj (listOrda cj pv)) pv (if cj (vla-startundomark acdoc)) v (redraw) lt lt) ;;; (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (foreach f lt (actTX (cadr f)) ) ) (setq pv (cadr l)) ) ) ) ((and pv (= (car l) 5) (not s)) (ventanea) ) (T (princ) ) ;;; HERE MORE CASES ?... ) (cond ((= (car l) 3) (entmake (list '(0 . "TEXT") (cons 8 capa) (cons 62 (if cl cl 256)) (cons 40 a) (cons 1 tx) (cons 10 (list (car p) (cadr p) 0.0)) ) ) (setq tx (dameTexto tx)) ) (T (if (/= (car l) 5) (princ) ) ) ;;; HERE MORE CASES ?... ) ) ) ) (while (>= (boole 1 (getvar "UNDOCTL") 8) 8) (vla-endundomark acdoc) ) (princ) )

@leonucadomi @PGia I'm attaching a new version V.3 that can also renumber block attributes. It also includes some other new features. However, I'm letting you know that <Something different> is going on 'holidays' and won't be serving any more requests for a while I'm attaching the description and new features of V.3: - Individual creation/renumbering of TEXTs and MTEXTs based on the cursor position - Multiple renumbering of TEXTs/MTEXTs via selection window (option key 'V') based on proximity to the first corner indicated on the screen of the selection window. That is: if the selection window is from Northwest to Southeast, the renumbering increment will be in order from least to greatest distance from the Northwest corner Added in this version: - Ability to detect and renumber block attributes using the same criteria as 'TEXT' and 'MTEXT' attributes. (Note: This may not work for block attributes with multiple levels of nesting.) - New functionality (by pressing the 'A' key) to change text alignment on the fly. A preview of how it works: SDifferent_V3.mp4 SDifferent_V3.lsp

@GLAVCVS I tried your program and it is very nice. Yesterday I was thinking of writing a random chord length routine but you seem to have a good solution, so now I will just study your code to see what I can learn.

A fairly simple task based on the smaple dwg. (defun c:numblk ( / ss num lst obj atts att1 numstr) (while (setq ss (ssget '((0 . "insert")))) (setq num (getint "\nEnter start number ")) (setq lst '()) (repeat (setq k (sslength ss)) (setq ent (entget (ssname ss (setq k (1- k))))) (setq inspt (cdr (assoc 10 ent))) (setq x (car inspt) y (cadr inspt)) (setq entname (cdr (assoc -1 ent))) (setq lst (cons (list Y X entname) lst)) ) (setq lst (vl-sort lst '(lambda (a b) (cond ((> (car a) (car b))) ((= (car a) (car b)) (< (cadr a) (cadr b))) ) ) ) ) (foreach blk LST (setq obj (vlax-ename->vla-object (caddr blk))) (setq atts (vlax-invoke obj 'Getattributes)) (setq att1 (car atts)) (cond ((< num 10)(setq numstr (strcat "00" (rtos num 2 0)))) ((< num 100)(setq numstr (strcat "0" (rtos num 2 0)))) ((setq numstr (rtos num 2 0))) ) (vlax-put att1 'textstring numstr) (setq num (1+ num)) ) ) (princ) )

This method is used quite a lot by @ronjonp so search in this forum then you should find many elegant and decent routines by him as I personally like reading his.

If you can find it, the older BlueBeam Vu reader can do this... LINK

@pkenewell I found this a while back and have it in my Change Color of Text LISP https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/multileader-text-color/m-p/7424985#M359595

That is possible - a great learning opportunity... have a go and come back with any questions maybe?

If there was, I would have included it in my list of examples.

change this : ("*EN-LITE-CIRC . 160) to this ("*EN-LITE-CIRC" . 160) and if you want to keep this line ERROR WTF MAYBE MAKE NEW SCRIPT ----------------------------------------------- LAYCOL add a ;; before the line as bigal pointed out ;;ERROR WTF MAYBE MAKE NEW SCRIPT ;;----------------------------------------------- ;;LAYCOL

@JerryFiedler " Reinaldo N. Togores" he has 4 books at least, look on Kindle can copy code from Kindle and paste into your lisp. Very cheap.

@JTM It is possible to do what you want using global variables. Care must be taken with global variable so you don't create name conflicts. The following code creates global variables *qty3BY6* and *len3BY6* which are probably unique enough to avoid conflict in your system. I added a subroutine to input values with a default. The subroutine comes from the book "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012. I believe there is a newer version. It is a good book for lisp. The following code uses global variables. ;Routine to create special fillet between two intersecting lines. ;https://www.cadtutor.net/forum/topic/97550-3-x-6m-long-chords-around-arc/#google_vignette ;Modified: Jerry Fiedler - Apr 2025 ; Determine angle by USER selecting two lines instead of numerical input. ; Added USER options to show arc and extend lines to apex. ;Revised: Jerry Fiedler - Apr 2025 ; Replaced Geometric Calculator function with custom routine CALang3P. ; Made line extensions a polyline. ; Added ability of user to input number of chords and their length. ;Revised: Jerry Fiedler - May 2025 ; Changed quantity and length input to global variables *qty3BY6* and *len3BY6*. ; Added subroutine for input with default values. ;Reference code: ; paulmcz - Equations for arc radius calculation. ; BigAl - Code for creating the arc and chamfers. ; LeeMac - Entmake code. ; Reinaldo Togores - Prompt for input with default values subroutine. ;++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ (defun c:3BY6 ( / ent1 ent2 obj1 obj2 p1 p2 p3 p4 pt apex rad u1 ux x end1 end2 arc len ans arcnm pS pE nodes j nm) ; Recall stored variables. ; If global variables are undefined set to zero. First time command called. (or *qty3BY6* (setq *qty3BY6* 0)) (or *len3BY6* (setq *len3BY6* 0.0)) ; Accept stored values or enter new values. (initget 6 ) ; No negative values or zero. (setq *qty3BY6* (default-value 'getint "\nEnter quantity of chords: " *qty3BY6*)) (initget 6 ) ; No negative values or zero. (setq *len3BY6* (default-value 'getreal "\nEnter chord length: " *len3BY6*)) ; Select lines. (setq ent1 (car (entsel "\nPick Line 1 "))) (setq ent2 (car (entsel "\nPick Line 2 "))) ; Get end points of selected lines. (setq obj1 (vlax-ename->vla-object ent1)) (setq obj2 (vlax-ename->vla-object ent2)) (setq p1 (vlax-get obj1 'startpoint)) (setq p2 (vlax-get obj1 'endpoint)) (setq p3 (vlax-get obj2 'startpoint)) (setq p4 (vlax-get obj2 'endpoint)) ; Calculate the intersection point Line 1 and Line 2. (setq apex (inters p1 p2 p3 p4 nil)) ; Calculate angle X. (if (equal apex p1 0.01)(setq end1 p2)(setq end1 p1)) (if (equal apex p3 0.01)(setq end2 p4)(setq end2 p3)) (setq x (CALang3P apex end1 end2)) (if (> x 180) (setq x (- 360 x))) (setq x (* pi (/ x 180.0))) ; Calculate the arc radius. (setq u1 (- pi x)) (setq ux (/ u1 (* 2 *qty3BY6*))) (setq rad(/ (/ *len3BY6* 2) (sin ux))) ; Create arc. (setvar 'filletrad rad) (command "fillet" ent1 ent2) (setq arcnm (entlast)) ; (command "chprop" arcnm "" "_LA" "P" "") (setq arc (vlax-ename->vla-object arcnm)) ; Establish nodes for chamfers. (setq len (/ (vlax-get arc 'arclength) *qty3BY6*)) (setq pS (vlax-get arc 'startpoint)) (setq pE (vlax-get arc 'endpoint)) (setq j 0) (repeat (1+ *qty3BY6*) (setq nodes (cons (vlax-curve-getpointatdist arc (* j len)) nodes)) (setq j (1+ j)) ) ; Create chord pline from list of nodes. ; Entmake code by Lee Mac (McDonnell) Febrary 2010 ; https://www.cadtutor.net/forum/topic/18257-entmake-functions/?tab=comments#comment-149347 (entmake (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length nodes))) (mapcar (function (lambda (p) (cons 10 p))) nodes)) ) ; Delete arc? (initget "YES NO") (setq ans "NO") (setq ans (cond ((getkword "\nSHOW ARC? [YES/NO] <YES>: ")) ("YES"))) (if (= ans "NO") (entdel arcnm)) ; Extend lines to apex? (initget "YES NO") (setq ans "NO") (setq ans (cond ((getkword "\nEXTEND LINES TO APEX? [YES/NO] <YES>: ")) ("YES"))) (if (= ans "YES") (progn (command "pline" pS apex pE "") ; (command "chprop" (entlast) "" "_LA" "P" "") ) ) (princ) ) ; +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; Prompt for input with default values. ; Source: "AutoCAD Expert's Visual LISP" by Reinaldo N. Togores - 2012 ; Listing 7.1 in source book. ; Arguments: ; func -> An AutoCAD get... function preceded with a ' (NOT for getstring) ; message -> Prompt requesting input. ; value -> Defalut value which is used if <Enter> is pressed at prompt. (defun default-value (func message value / tmp) (if (setq tmp (apply func (list (strcat message "<" (vl-princ-to-string value) ">: " ) ) ) ) tmp value ) ) (princ) THREE_SIX_Rev2.LSP

Looks like you're still working on the same thing. So I've given 'Something Different' a bit of a makeover to fit your needs. Substitutes for 'getpoint', 'entsel', and 'ssget', all in one at the same time. ;******** <<S o m e t h i n g d i f f e r e n t V.2>> ******** ;******************* p o r d e s í a r g o ******************** ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:txtIncrem (/ tam capa ind para a c cl txsel le l s dameTexto uconfig obtcad ent loc tipC nC ps add errores error0 v actTX ventanea pv n cj iniUM acdoc md ) (defun errores (mens) (setq *error* error0) (while (>= (boole 1 (getvar "UNDOCTL") 8) 8) (vla-endundomark acdoc) ) (prin1) ) (defun dameTexto (cad / v r l daleVuelta) ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE (defun daleVuelta (a) (cond ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a)) ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a)) ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a)) ) ) (foreach v (reverse (vl-string->list cad)) (if (or (not r) (minusp r)) (setq l (cons (abs (setq r (daleVuelta v))) l)) (setq l (cons v l)) ) ) (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l)) ) (defun ventanea (/ p no se) (if (listp (setq p (cadr l))) (progn (redraw) (grvecs (list 7 pv (setq no (list (car pv) (cadr p))))) (grvecs (list 7 pv (setq se (list (car p) (cadr pv))))) (grvecs (list 7 no p)) (grvecs (list 7 se p)) ) ) ) (defun actTX (e / le) (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget e))) le)) (setq tx (dameTexto tx)) nil ) (setq error0 *error* *error* errores ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object))) (while (>= (boole 1 (getvar "UNDOCTL") 8) 8) (vla-endundomark acdoc) ) (princ (setq s "Select PREVIOUS number text or type it... ")) (while (not para) (setq l (grread T 13 2)) (if (not (listp (cadr l))) (if (member (car l) '(2 3 11 25)) (cond ((or (= (cadr l) 13) (= (car l) 25) (= (car l) 11)) (if (and c (not (wcmatch c "*.*"))) (setq ind c para T) (if (not c) (setq para T)) ) ) ((> (cadr l) 31) (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l)))) (prompt (strcat "\r" s c)) ) ((= (cadr l) 8) (if (setq c (if c (substr c 1 (- (strlen c) 1)))) (prompt (strcat "\r" s c)) ) ) (T (princ) ) ) ) (if (= (car l) 3) (if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT")) (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*")) (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T) (princ "\n*** The selected object is not valid. Please, try again... ***") ) ) ) ) ) (setq para nil) (if (not capa) (while (not para) (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... "))) (setq l (entget e)) ) (if (= (cdr (assoc 0 l)) "TEXT") (setq capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T) (princ "\n*** The selected object is not a TEXT. Please, try again... ***") ) (if (not capa) (if (setq capa (getstring "\nType Layer name: ")) (if (tblsearch "layer" capa) (if (not (setq a (getreal "\nType Height: "))) (setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil) (setq para T) ) (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil) ) ) ) ) ) ) (setq tx (dameTexto ind) s nil) (while ;(and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3 2))) (and (setq l (grread T (cond (s 4) (v 4) (T 13)) (cond (s 2) ((and pv v) 1) (v 2) (T 0)))) (member (car l) '(5 3 2))) (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (<V> for ON/OFF multiple selection or <RIGHT CLICK> for exit)")) (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil n nil) (if (= (car l) 2) (cond ((member (cadr l) '(86 118)) (setq v (not v)) ) ;;; HERE MORE CASES ?...(ascii "V") ) (if (or v (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam)) (list (+ (car p) tam) (+ (cadr p) tam)) (list (cons 0 "TEXT")) ) ) ) (cond ((= (car l) 3) (if s (setq md (vla-startundomark acdoc) s (actTX (ssname s 0))) (if pv (if (setq cj (ssget "_C" pv (cadr l) (list (cons 0 "TEXT"))) pv (if cj (vla-startundomark acdoc)) v (redraw) cj cj) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (actTX e) ) ) (setq pv (cadr l)) ) ) ) ((and pv (= (car l) 5) (not s)) (ventanea) ) (T (princ) ) ;;; HERE MORE CASES ?... ) (cond ((= (car l) 3) (entmake (list '(0 . "TEXT") (cons 8 capa) (cons 62 (if cl cl 256)) (cons 40 a) (cons 1 tx) (cons 10 (list (car p) (cadr p) 0.0)) ) ) (setq tx (dameTexto tx)) ) (T (if (/= (car l) 5) (princ) ) ) ;;; HERE MORE CASES ?... ) ) ) ) (while (>= (boole 1 (getvar "UNDOCTL") 8) 8) (vla-endundomark acdoc) ) (princ) ) P.S.: Not for those who hate alternative 'medicine'

As far as I can tell, you can't identify the file containing the LISP directly. LISP is loaded into CAD and it is used from memory rather than CAD referring to the .lsp file, you could copy and paste the LISP into the command line and it will work just the same for example, likewise load from a file and modify or delete the .lsp file, what was loaded will still run OK. If the .lsp file is saved in a known location you can search these locations and read the files till you find the LISP function you want, and from that you can return the location and file name it contains. For example the Trusted locations are known, so you can search through them. For myself I have a small file, "Location.lsp" that contains the locations for my .lsp files, manually updated one file, all the others refer to this as necessary and this file is in the start-up suit. You can get a LISP to append to this file if you want, even so far as delete the file (you know it's location) and recreating it which can be handy if you have an install LISP: have locations.lps saved in trusted locations, get the user to specify a folder to 'install' .lsp files into, and then append to locations.lsp this new location

I would do a sort on Y then X makes sure the values are read from left to right, else may for some odd reason left and right are mixed. ; sorts on 1st two items (vl-sort lst '(lambda (a b) (cond ((< (cadr a) (cadr b))) ((= (cadr a) (cadr b)) (< (car a) (car b))) ) ) )

Hi In this new version, it's possible to enter the text before the first text you want to insert from the keyboard or, as before, select it on the screen. Additionally, it will now increment numeric, alphabetic, or alphanumeric text strings without any restrictions (except for non-alphanumeric characters, of course). @leonucadomi As for your suggestion to extend the code's functionality to block attributes, I may do something about this in the future. However, I'm sure there must be simpler routines that would do the job just as well. There are several block experts on this forum who will probably have something to say about this. But if not, I'll try to do it myself. ;************************ G L A V C V S ************************* ;************************** F E C I T *************************** (defun c:txtIncrem (/ tam capa ind para a c cl txsel le l s dameTexto obtcad ent loc tipC nC ps add errores error0 ) (defun errores (mens) (setq *error* error0) (prin1) ) (defun dameTexto (cad / v r l daleVuelta) ;;; WRITE HERE THE CODE YOU NEED TO CUSTOMIZE THE TEXT YOU WANT TO ENTER OR CREATE (defun daleVuelta (a) (cond ((and (> a 64) (< a 91)) (if (> (setq a (+ a 1)) 90) (setq a -65) a)) ((and (> a 96) (< a 123)) (if (> (setq a (+ a 1)) 122) (setq a -97) a)) ((and (> a 47) (< a 58)) (if (> (setq a (+ a 1)) 57) (setq a -48) a)) ) ) (foreach v (reverse (vl-string->list cad)) (if (or (not r) (minusp r)) (setq l (cons (abs (setq r (daleVuelta v))) l)) (setq l (cons v l)) ) ) (vl-list->string (if (minusp r) (cons (if (= r -48) 49 (car l)) l) l)) ) (setq error0 *error* *error* errores ) (princ (setq s "Select PREVIOUS number text or type it... ")) (while (not para) (setq l (grread T 13 2)) (if (not (listp (cadr l))) (if (member (car l) '(2 3 11 25)) (cond ((or (= (cadr l) 13) (= (car l) 25)) (if (and c (not (wcmatch c "*.*"))) (setq ind c para T) (if (not c) (setq para T)) ) ) ((> (cadr l) 31) (setq c (if c (strcat c (chr (cadr l))) (chr (cadr l)))) (prompt (strcat "\r" s c)) ) ((= (cadr l) 8) (if (setq c (if c (substr c 1 (- (strlen c) 1)))) (prompt (strcat "\r" s c)) ) ) ) ) (if (= (car l) 3) (if (and (setq e (nentselp (cadr l))) (= (cdr (assoc 0 (setq le (entget (setq e (car e)))))) "TEXT")) (if (not (wcmatch (setq ind (cdr (assoc 1 le))) "*.*")) (setq capa (cdr (assoc 8 le)) a (cdr (assoc 40 le)) cl (cdr (assoc 62 le)) para T) (princ "\n*** The selected object is not valid. Please, try again... ***") ) ) ) ) ) (setq para nil) (if (not capa) (while (not para) (if (and (setq e (car (entsel "\nLAYER/HEIGHT: Select a sample text object (ENTER or RIGHT CLICK to type it)... "))) (setq l (entget e)) ) (if (= (cdr (assoc 0 l)) "TEXT") (setq capa (cdr (assoc 8 l)) a (cdr (assoc 40 l)) para T) (princ "\n*** The selected object is not a TEXT. Please, try again... ***") ) (if (not capa) (if (setq capa (getstring "\nType Layer name: ")) (if (tblsearch "layer" capa) (if (not (setq a (getreal "\nType Height: "))) (setq capa (princ "\n*** A valid height has not been specified. Please, type it again... ***") capa nil) (setq para T) ) (setq capa (princ "\n*** Specified layer does not exist. Please, type it again... ***") capa nil) ) ) ) ) ) ) (setq tx (dameTexto ind)) (while (and (setq l (grread T (if s 4 13) (if s 2 0))) (member (car l) '(5 3))) (prompt (strcat "\rSelect text to modify or insert new text \"" tx "\" (RIGHT CLICK for exit)")) (setq tam (* (getvar "pickbox") (/ (GETVAR "VIEWSIZE") (CADR (GETVAR "SCREENSIZE")))) para nil) (if (setq s (ssget "_C" (list (- (car (setq p (cadr l))) tam) (- (cadr p) tam)) (list (+ (car p) tam) (+ (cadr p) tam)) (list (cons 0 "TEXT")) ) ) (cond ((= (car l) 3) (entmod (subst (cons 1 tx) (assoc 1 (setq le (entget (ssname s 0)))) le)) (setq tx (dameTexto tx)) ) ;;; HERE MORE CASES ?... ) (cond ((= (car l) 3) (entmake (list '(0 . "TEXT") (cons 8 capa) (cons 62 (if cl cl 256)) (cons 40 a) (cons 1 tx) (cons 10 (list (car p) (cadr p) 0.0)) ) ) (setq tx (dameTexto tx)) ) ;;; HERE MORE CASES ?... ) ) ) (princ) )

I'll update all of this to also allow you to enter the initial reference number from the keyboard, as @Nikon wanted. I'll post it soon.

I think the file that keeps your vlisp config is saved in : c:\Users\[*your-user-name*]\AppData\Roaming\Autodesk\AutoCAD 2017\R21.0\enu\VLIDE.DSK your autocad version is probably different , like ...\Autocad 2015\Rxx.0\enu\VLIDE.DSK maybe (setq dsk-filename (findfile "VLIDE.DSK")) will work. In my case it returns "C:\\temp\\lisp\\VLIDE.DSK" , I have write acces there but just put it there as backup / to study. This folder is at the top of my support path but I doubt it's the one loaded / saved on exit by the editor. Anyways , first warning : before you go crazy like a dragon and experiment , make sure you first make a backup , maybe more than one. In this file your have 2 lines : - one beginning with : (*edit-file-history* "C:/Temp/Lisp/_Cad-tutor/xxx.lsp" "C:/Temp/Lisp/_Cad-tutor/yyy.lsp" .......) - and multiple sections for every file open : (editor :CAPTION "xxx.lsp" :FILENAME "C:/Temp/Lisp/_Cad-tutor/xxx.lsp" :POINT 26786 :APEX 2162692 :SIZE 42468643 :STATE :MINIMIZED :RO nil :FGC nil :BGC nil :LXC T :LEX-ID :AL :CLV nil :TW 8 :LM 10 :CONTEXT :AUTOLISP ) (editor :CAPTION "yyy.lsp" :FILENAME "C:/Temp/Lisp/_Cad-tutor/yyy.lsp" :POINT 3528 :APEX 4259848 :SIZE 37946548 :STATE :MINIMIZED :RO nil :FGC nil :BGC nil :LXC T :LEX-ID :AL :CLV nil :TW 8 :LM 10 :CONTEXT :AUTOLISP ) etc etc... So ... the other first thing you could / should to is to check if you have / AutoCad has acces rights in the folder bladiebla...\enu\VLIDE,DSK I'm not sure I recommend trying to edit this file , but there it is , a possible way to get a grip on your digital Gremlin.

Welcome to CADTutor! I have moved your thread to the CAD Management Forum. Please post in the most appropriate Forum. All of your links but the last one are dead ends. I use similar to this when I do Architecture drawings or usually when I use AutoCAD Architecture, I use the layers that it creates for which objects I am creating. Standard CAD Layers for Architectural Drawings Are you using AutoCAD Architecture or just vanilla AutoCAD?

Just a comment in this situation these two do the same task. (vlax-put-property (vlax-put Another "Textgap" 'Textgap

If 'oldGap' is '(cdr (assoc 0 entData)))' then it will always be different from 0.425 because oldGap= "DIMENSION" If you want to get the current value of "TextGap" from the object contained in 'dim' you should call '(vlax-get-property (vlax-ename->vla-object dim) "TextGap")' But not '(cdr (assoc 0 entData))'

if this is on a company computer / network this may be caused by not having write access to the right folder , or , if your profile (registry) is reset (wiped) every time / morning you log in. Last one is easy enough to test. After you log in and open a lisp file , close AutoCad and start it again and see if your lisp files are still there or that AutoCad suddenly developed Alzheimer. You could also check your shortcut on your desktop. If it contains a /P parameter, it may start up with a fixed profile. First thing I always do is make my AutoCad local again. If you start AutoCad from your windows start button , this probably won't have a startup profile attached to it. So lots of options to explore before begging IT and bend over.

Now this code works very well. Thank you very much!

Like This (defun c:Ch-DimTxtOff ( / ss entData n) (setq ss (ssget '((0 . "DIMENSION")))) (while (and (setq dim (ssname ss (setq n (if n (1+ n) 0)))) (= (cdr (assoc 0 (entget dim))) "DIMENSION")) (vlax-put-property (vlax-ename->vla-object dim) "TextGap" 0.425) ) (princ) )

You just need to replace the entire block under 'progn' with (vlax-put-property (vlax-ename->vla-object dim) "TextGap" 0.425)

The problem is that there's no DXF code 147 to control the text gap. That's controlled directly from the coordinate associated with code 11. From VLA, you can control the gap using the "TextGap" property.

Okay I guess it was also necessary to update from 'if' to 'while' I edited that a few minutes ago, too.

(defun c:Ch-DimTxtOff ( / ss entData n) (setq ss (ssget '((0 . "DIMENSION")))) (while (and (setq dim (ssname ss (setq n (if n (1+ n) 0)))) (= (cdr (assoc 0 (entget dim))) "DIMENSION")) (progn (setq entData (entget dim)) (setq entData (subst (cons 147 0.425) (assoc 147 entData) entData)) (entmod entData) ) ) (princ) ) I just added the code to define 'dim' I haven't checked anything else.

(ENTGET DIM).. DIM is not defined

TRY https://help.autodesk.com/view/OARX/2022/ENU/?guid=GUID-E39FFEDE-FF81-4071-81E9-02D9C376D918

In the below post I demonstrate a concept program to facilitate mirroring a block without mirroring the text it contains: https://www.theswamp.org/index.php?topic=46271.msg513250#msg513250

Update to above: Looking at this with CAD running this morning. For my code above you need to 'entmake' the block entities within the block definition part rather than draw them - possible to do but you don't get the graphical view on the screen what you are doing. Switched it around to select the entities first, copy them within the block definition then delete the originals once the block is created. Insert the block using entmake method - a bit neater I think to make a block on a set layer - rather than altering the drawing layer settings and back or inserting a block and then switching the layer after. You can add any entities you like to the block or adjust the (ssget) part to filter as required. I've put the 'fixed' details like block name as separate variables - it is possible to have user inputs here for some versatility. (defun c:test ( / MySS acount MyBlockName Origin MyLayer) (setq MySS (ssget)) ;;Select entities to convert to a block (setq MyBlockName "Retaining_Wall") ;;Block Name, change as required. Could use uaser input for block name (setq Origin (getpoint "Select Block Origin")) ;;Block origin,alter as required. Could hard code this to say (0 0 0) (setq MyLayer "RetainingWall") ;;Layer Name. Could use user input for layer name (setq LayerColour 1) ;;Layer Colour. (if (not (tblsearch "LAYER" MyLayer)) (command "-LAYER" "_M" MyLayer "_C" LayerColour MyLayer "")) ;; Create layer if necessary (setq NewBlock (entmakex (list (cons 0 "BLOCK") (cons 2 MyBlockName) (cons 70 64) (cons 10 Origin) )) ) ;;Start block definition (setq acount 0) ;; A counter (while (< acount (sslength MySS)) ;; make entities withn block (entmake (entget (ssname MySS acount))) ;; Remake entity within block (setq acount (+ acount 1)) ) ; end while (setq EndBlock (entmakex '((0 . "ENDBLK"))) ) ;;Finish Block definition (command "erase" MySS "") ;;Delete original objects, comment out if not required (entmakex (list (cons 0 "INSERT") (cons 67 0) (cons 100 "AcDbEntity") ;; insert the block (cons 8 MyLayer) ;;Use layer here, no need to set current layer settings in drawing (cons 100 "AcDbBlockReference") (cons 2 MyBlockName) (cons 10 Origin) (cons 41 1.0) (cons 42 1.0) (cons 43 1.0) (cons 50 0.0) (cons 70 0) (cons 71 0) (cons 44 0.0) (cons 45 0.0) )) (command "regen") ;; Regen Drawing (princ) )

You can thing of those as name spaces of ObjectARX. Rx = AcRx, the most base classes for all AutoCAD objects Ge = AcGe, Geometry classes, Points, Vectors, Curves Gi = AcGi , has the class AcGiDrawable, mostly responsible for drawing entities on your screen Gs = AcGs, Graphics system, access to drawing devices and of course getBlockImage Ap = Application level stuff such as the document manager Db = AcDb, the database (.DWG) Ed = AcEd, Editor, selection sets, entsel, getPoint Ax = all of the ActiveX stuff Br = AcBr, access to 3d geometry Brx = stuff specific to BricsCAD. there’s also BrxBim and BrxCv They are all in PyRx, and are loaded in the ARX, so its ok to just include them all Also the .NET documentation is relevant, see Unmanaged to Managed Class Mappings https://help.autodesk.com/view/OARX/2024/ENU/?guid=GUID-390A47DB-77AF-433A-994C-2AFBBE9996AE

Nice! Autofit to the rescue! Note that PyRx has a full GUI in wxPython (wx), so you can use that instead of ctypes if you want. Then there’s also alert from pyrx import Rx, Ge, Gi, Gs, Db, Ap, Ed, Ax, Brx import traceback import wx @Ap.Command() def doit(): try: wx.MessageBox("Now you have done it") Ed.Core.alert("Now you have done it") except Exception as err: traceback.print_exception(err) Welcome to Python

@Danielm103 1. about aligning the image to the center of the cell: I changed the X offset value (A process of trial and error and depends on the length of the header text): {"x_offset": 35, "y_offset": 0, "x_scale": 0.8, "y_scale": 0.8} 2. the first column was invisible because "val" for those cells was empty after the header's row and those tow lines return empty string after the first row which set the column width to 0: w, h =table.calcTextExtents(val,table.textStyle(cell.row, cell.column)) ws.set_column(cell.column,cell.column, w, cell_format) so I did this change with "autofit": else: #val = table.textString(cell.row, cell.column) #try to get a text width #w, h =table.calcTextExtents(val,table.textStyle(cell.row, cell.column)) ws.set_column(cell.column,cell.column, 1, cell_format)#minimum width,autofit wil set at the end ws.write(cell.row, cell.column, table.textString(cell.row, cell.column)) ws.autofit() wb.close() here is the final code I'm using: #https://www.cadtutor.net/forum/topic/97450-export-table-with-blocks-to-excel-with-python/ from pyrx import Rx, Ge, Gi, Gs, Db, Ap, Ed, Ax, Brx import traceback import pathlib import xlsxwriter import ctypes import wx @Ap.Command() def Py_tablewithimagetoexcel_xlsxwriter(): try: db = Db.curDb() ps, id, _ = Ed.Editor.entSel("\nSelect a table: ", Db.Table.desc()) if ps != Ed.PromptStatus.eOk: raise RuntimeError("Selection Error! {}: ".format(ps)) xlpath = pathlib.Path(db.getFilename()).parent xlname = pathlib.Path(db.getFilename()).stem fpt = "{}/{}.xlsx".format(xlpath, xlname) wb = xlsxwriter.Workbook(fpt) # create workbook ws = wb.add_worksheet() # create worksheet in workbook ws.set_default_row(40) # set default row height to 39.6 cell_format = wb.add_format() # add format cell_format.set_align("center") cell_format.set_align("vcenter") table = Db.Table(id) opts = Db.TableIteratorOption.kTableIteratorSkipMerged for cell in table.cells(opts): if table.cellType(cell.row, cell.column) == Db.CellType.kBlockCell: ws.set_column(cell.column,cell.column, 15.44, cell_format) blk = table.blockTableRecordId(cell.row, cell.column) bname = getEffectiveNameFromBtrId(blk) img: wx.Image = Gs.Core.getBlockImage(blk, 64, 64, 1.0, [0, 0, 0]) img.SetMaskColour(0, 0, 0) img.SetMask(True) imgpath = "{}/{}.png".format(xlpath, bname) img.SaveFile(imgpath, wx.BITMAP_TYPE_PNG) ws.insert_image( cell.row, cell.column, imgpath, {"x_offset": 35, "y_offset": 0, "x_scale": 0.8, "y_scale": 0.8}, ) else: #val = table.textString(cell.row, cell.column) #try to get a text width #w, h =table.calcTextExtents(val,table.textStyle(cell.row, cell.column)) ws.set_column(cell.column,cell.column, 1, cell_format)#keep format,set minimum width,autofit will set at the end ws.write(cell.row, cell.column, table.textString(cell.row, cell.column)) ws.autofit() wb.close() ctypes.windll.user32.MessageBoxW(0, fpt , "Files Saved", 1) except Exception as err: traceback.print_exception(err) def getEffectiveNameFromBtrId(btrid: Db.ObjectId): rec = Db.BlockTableRecord(btrid) if rec.isAnonymous(): ids = rec.getBlockReferenceIds() if len(ids) > 0 and Brx.DbProperties.isValid(ids[0], "EffectiveName~Native"): val = Brx.DbProperties.getValue(ids[0], "EffectiveName~Native") return val.getString() return rec.getName() Thanks for all your help!! aridzv.

It does seem to give more control, I would consider renaming the column BLOCK PREVIWE, to something shorter, or less than the size of the icon, maybe just IMAGE, or BLOCK

thanks I replaced "dir" with a valid path and it worked.

Easter Sunday, CAD is off but extracting, copy and paste with no testing I think this is kind of what you are looking to add into a code: Things like escape will escape the full LISP where as finishing entity like polyline with enter will let it continues as it should. Can add in details to create the block at a specific layer - add the 'cons 8' example fuccaro above, but first see if this works. Technique is to create the block, then the entities and then finish the block (setq MyBlockName "Retaining_Wall") ;;Block Name, change as required (setq origin (list 0 0 0)) ;;Block origin,alter as required (entmake (list '(0 . "BLOCK") (cons 2 MyBlockName) (cons 70 64) (cons 10 origin) )) ;;Start block definition ;;Create the block entities here: (command "PLINE") ;;..... ;;Finish block entities. (entmakex '((0 . "ENDBLK"))) ;;Finish Block definition (setq NewBlock (tblobjname "BLOCK" MyBlockName)) ; entity description of new block. Think could also use (entlast) ? (command "-insert" NewBlock pause "" 1 pause) ;; Insert block, scale 1. 'NewBlock' might be MyBlockName ?

Lee Mac is a brilliant resource.... Google "Lee Mac Browse for Folder" to get another of his excellent LISPs (and also a handy link to donate if you like his stuff) It includes the line: fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg bit dir) which you could look at to modify this line above: Folder (vlax-invoke-method ShlObj 'BrowseForFolder 0 Message 0) Think it just needs "dir" adding and remember to use double "\\" in the file path, miht also need to add a check that the hard coded folder exists (still, IT have odd habits)

Based on the answers given so far, it's possible I haven't fully understood your question. But I'll answer it anyway. If you want to interactively view the block to be inserted during the insertion process, you should first check if the command offers that option during execution: type '(command "_insert" "RetainingWall")' on the command line and add parameters to see if the command's behavior suits your needs. If not, then you can resort to a safer solution: the "move" command. The idea is to first insert the block at point 0,0 and call "(command "_move" (entlast) '(0 0))" And... voilà: you'll have the block visible at your cursor, waiting for you to tell it where to place it.

Just a small hint: If you create the polyline vith entmake, just put something like (cons 8 "RetainingWall"). It will put the polyline on the desired layer if that layer exists and it will create it if it doesen't. Also I vould use a shorter name for the program name.

These don't make any sense to me ? 4059 +45899 * 0.452 828MM 25.27 M 3.06 +45.90 * 0.45 0.83 M 25.27 M Explain more what it is you want do 1 line per step.

Thanks!!! hope bricscad support will help. for me at least there is no pressure. Right now we know how to build a table in AutoCAD that contains values that Python knows how to work with. and I do belive bricscad will help. aridzv.

getEffectiveNameFromBtrId helper works for AutoCAD, however BricsCAD doesn’t have a direct API to do this for parametric blocks, I’m investigating alternatives. vla-get-effectivename, "EffectiveName~Native" are designed to give us the name from a block reference blk = table.blockTableRecordId(cell.row, cell.column) gives us a Block table record id, not a reference I have a working solution with the help of Bricsys support that should give us what we need, it’s a bit of a kludge though

Yes, that is possible, might need a few more details though. Second thing to ask, what are your LISP abilities like, do you want to create the solution if we give you hints and help along the way or will you need more guidance?

@Danielm103 Sorry, I should have included this code and the example drawing in my previous comment. (defun c:geteffectivenamebr (/ selblk blknm) (setq selblk (car(entsel "\nSelect block : "))) (setq blknm (getpropertyvalue selblk "EffectiveName~Native")) ;;Bricscad (alert blknm) (princ) ) geteffectivenamebricscad.dwg

(defun c:GLVScopi (/ cj cj1 n e mx my para) (if (setq cj (ssget '((0 . "*TEXT")))) (while (not para) (setq cj1 (ssadd)) (while (setq e (ssname cj (setq n (if n (1+ n) 0)))) (setq tx (cdr (assoc 1 (setq l (entget e)))) mx (if mx (min (cadr (assoc 10 l)) mx) (cadr (assoc 10 l))) my (if my (min (caddr (assoc 10 l)) my) (caddr (assoc 10 l))) ) (entmake (subst (cons 1 (strcat (chr (+ (ascii (substr tx 1 1)) 1)) (substr tx 2))) (assoc 1 l) l)) (ssadd (entlast) cj1) ) (command "_move" cj1 "" (list mx my)) (setq cj cj1 cj1 nil n nil mx nil my nil) ) ) (princ) ) @Ish I edited it from my smartphone, so I couldn't test it. Check it yourself if it works.

Lee has some cool ones for this task: https://www.lee-mac.com/objectalign.html https://www.lee-mac.com/autoblockbreak.html

just my old code. Converts a field still in the tables (defun C:CFT ()(ConvField->Text t)) (defun C:CFTAll ()(ConvField->Text nil)) (defun C:CFTSEL( / *error* Doc ss CountField) (vl-load-com) (defun *error* (msg)(princ msg)(vla-endundomark doc)(princ)) (setq Doc (vla-get-activedocument (vlax-get-acad-object))) (vla-startundomark Doc) (if (setq ss (ssget "_:L")) (progn (setq CountField 0) (foreach obj (mapcar (function vlax-ename->vla-object) (vl-remove-if (function listp) (mapcar (function cadr) (ssnamex ss)))) (setq CountField (ClearField Obj CountField)) ) (princ "\nConverting Field in ")(princ CountField) (princ " text's") ) ) (vla-endundomark Doc) (command "_.Regenall") ) (defun ClearField ( Obj CountField / txtstr att ) (cond ((and (vlax-write-enabled-p Obj) (= (vla-get-ObjectName obj) "AcDbBlockReference") (= (vla-get-HasAttributes obj) :vlax-true) ) ;_ end of and (foreach att (append (vlax-invoke obj 'Getattributes) (vlax-invoke obj 'Getconstantattributes) ) (setq txtstr (vla-get-Textstring att)) (vla-put-Textstring att "") (vla-put-Textstring att txtstr) (setq CountField (1+ CountField)) ) ;_ end of foreach ) ((and (vlax-write-enabled-p Obj) (vlax-property-available-p Obj 'TextString) ) ;_ end of and (setq txtstr (vla-get-Textstring Obj)) (vla-put-Textstring Obj "") (vla-put-Textstring Obj txtstr) (setq CountField (1+ CountField)) ) ((and (vlax-write-enabled-p Obj) ;_Table (eq (vla-get-ObjectName Obj) "AcDbTable") ) (and (vlax-property-available-p Obj 'RegenerateTableSuppressed) (vla-put-RegenerateTableSuppressed Obj :vlax-true) ) (VL-CATCH-ALL-APPLY '(lambda (col row / i j) (setq i '-1) (repeat col (setq i (1+ i) j '-1) (repeat row (setq j (1+ j)) (vla-SetText Obj j i (vla-GetText Obj j i)) (setq CountField (1+ CountField)) ) ) ) (list (vla-get-Columns Obj) (vla-get-Rows Obj) ) ) (and (vlax-property-available-p Obj 'RegenerateTableSuppressed) (vla-put-RegenerateTableSuppressed Obj :vlax-false) ) ) (t nil) ) CountField ) (defun ConvField->Text ( Ask / Doc *error* ClearFieldInAllObjects ) ;;; t - Ask user nil - convert ;;; Как все поля чертежа сразу преобразовать в текст? ;;; Convert Field to Text ;;; Posted Vladimir Azarko (VVA) ;;; http://forum.dwg.ru/showthread.php?t=20190&page=2 ;;; http://forum.dwg.ru/showthread.php?t=20190 (vl-load-com) (defun *error* (msg)(princ msg) (mip:layer-status-restore) (vla-endundomark doc)(princ) ) (defun loc:msg-yes-no ( title message / WScript ret) (setq WScript (vlax-get-or-create-object "WScript.Shell")) (setq ret (vlax-invoke-method WScript "Popup" message "0" title (+ 4 48))) (vlax-release-object WScript) (= ret 6) ) (defun ClearFieldInAllObjects (Doc / txtstr tmp txt count CountField) (setq CountField 0) (vlax-for Blk (vla-get-Blocks Doc) (if (equal (vla-get-IsXref Blk) :vlax-false) ;;;kpbIc http://forum.dwg.ru/showpost.php?p=396910&postcount=30 (progn (setq count 0 txt (strcat "Changed " (vla-get-name Blk)) ) (grtext -1 txt) ;;; (terpri)(princ "=================== ")(princ txt) (if (not (wcmatch (vla-get-name Blk) "`*T*")) ;_exclude table (vlax-for Obj Blk (setq count (1+ count)) (if (zerop(rem count 10))(grtext -1 (strcat txt " : " (itoa count)))) (setq CountField (ClearField Obj CountField)) ) ;_ end of vlax-for ) ) ) ;_ end of if ) ;_ end of vlax-for (vl-cmdf "_redrawall") CountField ) (setq Doc (vla-get-activedocument (vlax-get-acad-object))) (mip:layer-status-save)(vla-startundomark Doc) (if (or (not Ask ) (if (= (getvar "DWGCODEPAGE") "ANSI_1251") (loc:msg-yes-no "Внимание" "Все поля будут преобразованы в текст !!!\nПродолжить?" ) (loc:msg-yes-no "Attension" "All fields will be transformed to the text!!!\nto Continue?" ) ) ) (progn (princ "\nConverting Field in ") (princ (ClearFieldInAllObjects Doc)) (princ " text's") ) (princ) ) (mip:layer-status-restore)(vla-endundomark Doc) (command "_.Regenall") (princ) ) (defun mip:layer-status-restore () (foreach item *MIP_LAYER_LST* (if (not (vlax-erased-p (car item))) (vl-catch-all-apply '(lambda () (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))) ) ;_ end of vla-put-freeze ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of if ) ;_ end of foreach (setq *MIP_LAYER_LST* nil) ) ;_ end of defun (defun mip:layer-status-save () (setq *MIP_LAYER_LST* nil) (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)) ) ;_ end of vla-get-layers (setq *MIP_LAYER_LST* (cons (list item (cons "freeze" (vla-get-freeze item)) (cons "lock" (vla-get-lock item)) ) ;_ end of cons *MIP_LAYER_LST* ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (if (= (vla-get-freeze item) :vlax-true) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)) ) ;_ end of vl-catch-all-apply ) ;_ end of if ) ;_ end of vlax-for ) ;_ end of defun The Russian-language forum at Edward spied another idea to transform the field in the text (remove dictionary "ACAD_FIELD"), but has not been able to test it fully in all primitives (vl-load-com) (defun C:field-to-text () (if (and (setq txt-nabor (ssget '((0 . "mtext,insert")))) (setq txt-nabor (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex txt-nabor) ) ) ) ) ) (mapcar '(lambda (x / dict) (cond ( (and (= (vla-get-objectname x) "AcDbMText") (= (vla-get-HasExtensionDictionary x) :vlax-true) ) (vlax-for item (setq dict (vla-GetExtensionDictionary x)) (if (= (vla-get-name item) "ACAD_FIELD") (progn (vla-remove dict "ACAD_FIELD") (vla-put-textstring x (vl-string-trim "%<>" (vla-get-textstring x)) ) ) ) ) ) ( (= (vla-get-objectname x) "AcDbBlockReference") (vlax-for item2 (vla-item (vla-get-blocks (vla-get-ActiveDocument (vlax-get-acad-object) ) ) (vla-get-name x) ) (if (and (= (vla-get-objectname item2) "AcDbMText") (= (vla-get-HasExtensionDictionary item2) :vlax-true) ) (vlax-for item3 (setq dict (vla-GetExtensionDictionary item2)) (if (= (vla-get-name item3) "ACAD_FIELD") (progn (vla-remove dict "ACAD_FIELD") (vla-put-textstring item2 (vl-string-trim "%<>" (vla-get-textstring item2) ) ) ) ) ) ) ) ) ) ) txt-nabor ) ) (princ) )

For those of you that are uneasy with clicking the link you can also download the attachment to this post and look at the picture below. Please help. Thanks! CIRCLE_CLOSED.dwg