Leaderboard

(nth (vl-position (max var1 var2 var3 var4) (list var1 var2 var3 var4) (list "var1" "var2" "var3" "var4")) This is one of the possible ways

I used CSD sitting on top of CIV3D but I am pretty sure you do not need a program, if you kept the original pline defining the alignment you can amend it and remake the Alignment. Give it a try please let me know. Forums/autodesk has a CIV3D forum maybe ask there also. I know with lisp can get at the Alignment may not need C#. Alignment properties ; write out alignment details version 1 ; by Alan H Oct 2019 (defun c:alignlab (/ ste stn ende endn len ch ans fo fname delta ) (setq seg 1) (setq dwgname (vl-filename-base (getvar 'dwgname))) (setq fname (strcat (getvar 'dwgprefix) dwgname ".csv")) (setq fo (open fname "w")) ;(setq ans "Segment,Ch,StationE,StationN,EndstE,ENDstN,Length,CenterE,CentreN,Rad,Delta,Tanlength") (setq ans "Segment,Ch,StationE,StationN,Length,CenterE,CentreN,Rad,Delta,Tanlength") (write-line ans fo) (setq obj (vlax-ename->vla-object (car (entsel "pick Alignment")))) (vlax-for objid (vlax-get-property obj 'entities) (setq altyp (vla-get-type objid)) (setq ch (rtos (vlax-get-property objid 'StartingStation) 2 3)) (setq stE (rtos (vlax-get-property objid 'StartEasting) 2 3)) (setq stN (rtos (vlax-get-property objid 'StartNorthing) 2 3)) (setq endE (rtos (vlax-get-property objid 'EndEasting) 2 3)) (setq endN (rtos (vlax-get-property objid 'EndNorthing) 2 3)) (setq chend (rtos (vlax-get-property objid 'EndingStation) 2 3)) (setq len (rtos (vlax-get-property objid 'Length))) ;(setq ans (strcat (rtos seg 2 0) "," ch "," ste "," stn "," ende "," endn "," len)) (setq ans (strcat (rtos seg 2 0) "," ch "," ste "," stn "," len)) (if (= altyp 2) (progn (setq cenE (rtos (vlax-get-property objid 'CenterEasting) 2 3)) (setq cenN (rtos (vlax-get-property objid 'CenterNorthing) 2 3)) (setq rad (rtos (vlax-get-property objid 'radius) 2 3)) (setq delta (vlax-get-property objid 'delta)) (setq delta (rtos (/ (* delta 180.0) pi) 2 3)) (setq tang (rtos (vlax-get-property objid 'ExternalTangent) 2 3)) (setq PIStn (rtos (vlax-get-property objid 'PIStation) 2 3)) (setq ans (strcat ans "," cene "," cenn "," rad "," delta "," tang)) ) ) (write-line ans fo) (princ ans) (princ "\n") (setq ans nil) (setq seg (+ seg 1)) ) (setq ans (strcat (rtos seg 2 0) "," chend "," ende "," endn )) (write-line ans fo) (close fo) (alert (strcat "All done look in \n\n" fname)) (princ) ) (c:alignlab) (defun test () (setq obj (vlax-ename->vla-object (car (entsel "pick Alignment")))) (vlax-for objid (vlax-get-property obj 'entities) (vlax-dump-object objid) ) )

An interesting feature is that if you select a text like L1, the numbering continues to L9, then comes M0...M9, etc.

The only thing missing is to number blocks with attributes or individual attributes.

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) )

@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