All Activity

I have just created a load of blocks for future use, they where in the block panel, but have now disappeared? is thewre a tutorial for creating a block library. Using 2026LT

have a look on this topic;

I think this is something that Civil3D covers - BigAl knows these things better than me though. This is a very quick and dirty LISP: Noting that your lines are 1000x longer than the reference texts, I have a multiplier (hit enter to just accept the 1000, you can change the code to suit) Select the reference polyline - I am assuming always a horizontal reference line as your example Select the point that the height texts refer to (is it the centre of the '+', in the drawing there is a point drawn at the correct height next to each text) and then the associated text. Repeat along the points Exit badly with the escape key. I am going to get abuse for cutting corners there... Slight difference to your example that my lines are drawn from the closest point on the polyline that you selected (defun c:test ( / Multiplier ReferencePoly ReferenceY EndLoop MyPoint MyHeight MyHt ClosestPoint) (defun MkLn ( pt1 pt2 Layer / Ln ) ;; Add in layer etc details (setq Ln (entmakex (list '(0 . "LINE") '(100 . "AcDbEntity") '(410 . "Model") '(62 . 0) '(100 . "AcDbLine") (cons 8 Layer) (cons 6 "CONTINUOUS") (cons 62 256) (cons 10 pt1) (cons 11 pt2) '(210 0.0 0.0 1.0) ))) ; end list, entmakex, setq ) (setq Multiplier (getreal "Enter Height Multiplier (1000)")) (if (or (= Multiplier nil)(= Multiplier "")(= Multiplier 0)) (setq Multiplier 1000) ) (setq ReferencePoly (car (entsel "Select Reference Polyline"))) (setq ReferenceY (cdr (assoc 10 (entget ReferencePoly)))) (setq EndLoop "No") (while (= EndLoop "No") (setq MyPoint (getpoint "Select Point")) (setq MyHeight (car (entsel "Select Height text"))) (setq MyHt (cdr (assoc 1 (entget MyHeight)))) (setq ClosestPoint (vlax-curve-getclosestpointto ReferencePoly MyPoint)) (MkLn ClosestPoint (mapcar '* '(1 1 0) (mapcar '+ (list 0 (* Multiplier (atof MyHt)) 0) ClosestPoint)) "0") ) )

We are excited to announce the release of AutoCAD 2026.1.1, which includes important enhancements that will significantly elevate your design, drafting and collaborative workflows. This update, which can be installed via the Autodesk Access application, focuses on improving the Sheet Set Manager feature and making Smart Blocks fully functional. Dive into the details below! Enhanced Functionality With the Connected Sheet Set Manager The Sheet Set Manager receives a substantial upgrade in AutoCAD 2026.1.1. Here’s what’s new: Cloud Sheet Sets: The Connected Sheet Set Manager now fully supports working with, and organizing, cloud sheet sets. This update enhances performance when loading and handling these sheet sets, making your workflows smoother and saving you time. Real-Time Collaboration: Clear indicators for the status of your sheet sets are now visible, informing you of concurrent edits by other collaborators and providing you with real-time notifications of data conflicts. This feature ensures that you’re always aware of changes being made, allowing for better collaboration with your team. Removal of Sheet Set Manager for Web: Please note that the Sheet Set Manager for Web has been removed starting with this release of AutoCAD 2026.1.1. This change aims to streamline processes and focus on enhancing the desktop experience. The Connected Sheet Set Manager delivers the same concurrent editing experience as it did on the Web, but also ensures consistent workflows for more experienced users, whether they are working in Autodesk Docs or locally. Important Notice: Working with sheet sets between AutoCAD 2026.1.1 and Autodesk Civil 3D 2026 or 2026.1 may result in compatibility issues. For an enhanced and fully supported workflow we recommend waiting for the next Autodesk Civil 3D 2026 update. Smart Blocks: Detect and Convert Fully Implemented We are thrilled to announce that the detection capability and functionality of Smart Blocks are now fully implemented and no longer in Tech Preview. Initially introduced in AutoCAD 2026, Smart Blocks: Detect and Convert scans your entire drawing using the power of Autodesk AI, and then makes intelligent inferences to determine all the instances that you may want to convert into blocks. Detecting these potential blocks all at once is especially helpful in situations when extensive cleanup is required or when geometry may vary slightly, such as for imported drawings. AutoCAD 2026.1.1 brings significant improvements to your design experience, making sheet set management more fluid and Smart Blocks functionality more robust. These enhancements reinforce our commitment to providing you with the tools you need for a successful and efficient design workflow. Update to AutoCAD 2026.1.1 today If you already started your update at the beginning of this post, you should be one step closer to experiencing these features first-hand—if not, go ahead and go to the Autodesk Access application on your desktop. And if you’re not yet a subscriber, be sure to check out a free trial of AutoCAD 2026.1.1 Learn More To explore these features and enhancements in detail along with more additional updates included in the 2026.1.1 update, take a look at the following page in the Help section: What’s New in AutoCAD 2026.1.1 The post What’s New in AutoCAD 2026.1.1: Experience the Connected Sheet Set Manager and Enhanced Smart Blocks appeared first on AutoCAD Blog. View the full article

I fixed some of the errors, could you try again @PGia ? I see your point, it would be good to add the exact points on the corners to the estimated points from the rest of the function. Combine them into one polyline for a better result. I'll give it a try later when I have some time.

Being lazy as i am, and having done this a bazillion times, my brain says why not ask those that know if it is possible... So, we generate cross sections from very dodgy architects/landscape/civil engineers/ blokes called Bob etc drawings sent in for quotes... Quality of drawings we are sent can range from beer mat to Picasso.... Now then, we arrange the dodgy levels along the datum line, draw short polylines and stretch north wards by given a level, then join together to form a ground profile. My question is... would it be possible to create a lisp that we can use were we select a polyline along the datum line and then select the text adjacent and it would extend the polyline north of the datum line by the text amount ?? Polylinelisp.dwg

I’ve also tested @mhupp’s code. It gets fairly close to the centerline, but some strange errors appear. I think relying solely on finding the correct axis vertices probably means you can’t immediately compensate for an inaccurate result. That’s the downside of both Mhupp’s and GLAVCVS’s codes (his “one-eyed” version also produces odd results at times). SLW210’s approach might offer both options, but its outcome isn’t any better either. I suppose a method based on calculating many points helps to average out those errors, but the result can only be an approximation. And IMO, the result shouldn’t be an approximation — it should be exact.

@dexus I tested your first code. It's quite close to what the centerline should be, although at the inflection points it always works by approximation. It seems the goal is to obtain many points along the line to always be close to the correct axis, but: why not obtain the correct axis from the first point? In my opinion, it should be possible to obtain only the inflection points that will become segments equidistant from the reference polylines. Furthermore, in the middle of these inflection points there shouldn't be any more unnecessary points, but rather a single segment. As for your last code, I couldn't get it to run because some kind of error occurs.

bunlar var ama 21 yetersiz 41 de baska sorunlar var NEST21.lsp NEST41.lsp

selam yerleşim için lisp örneği buldun mu

I made some changes so it also works when the starting lines are intersecting. Cool to see lots of people try to solve this problem! Mine doesn't work well with parallel lines and doesn't generate arcs. It still looks like GP_'s solution has the best result for me, but for intersecting lines I have to execute the function twice and select the lines in two directions to get the full result. centerline.lsp

Hi, Im new here. I was wondering if exist any lisp routine to create multiple viewport from model space to layout at once. I have 190 polyline object "rectangular" in modelspace and i want to create viewports in paprespace at one time with the same scale besides each other? Thx ... Iztok

With my code it wouldn't matter because they would reorder on how they fall on the temp polyline unless one poly line is really squiggly (technical term)

here is a lisp that I'm using. make sure to set "TEXTSIZE" varaible to the text size value you need before ruuning it. ; KoordinatenRand.lsp Lisp-datei zum Zeichnen von Koordinaten an Ansichtsfenster ; erstellt 12/03 Th.J. ; 06/07 einfaches Errorhandling hinzugefuegt ; 06/07 Fehler bei Abweichung von Koordinatenrichtung und Winkeleinheiten beseitigt ; 09/07 Auswahl ob Anschreiben innen oder aussen vom AF ; 26/17 cadde interna.commands ; ; Vorhaben: waehle Ansichtsfenter und zeichne im Plotbereich an das AF die Koordinaten (Linien und Werte) ; des dargestellten (Lage)planausschnittes ; ; ;;(princ "Start with coordinate border") ; Errorhandling (defun my_error (msg) (print (strcat "Error occurred: " msg)) (command "_undo" "_back") (setq *error* alterror) (setvar "blipmode" sblip) (setvar "cmdecho" scmde) (setvar "osmode" sosmode) (setvar "angbase" sangbase) (setvar "angdir" sangdir) (setvar "aunits" saunits) (princ) ) ; (defun antwort(frage antw1 antw2 / antw kw) (setq kw (strcat antw1 " " antw2)) (initget 1 kw) (setq antw (substr (getkword frage) 1 1)) ) ; ende defun antwort (defun Txtin (ptin hgt str j72 j73 ang / ) (entmakex (list (cons 0 "TEXT") (cons 10 ptin) (cons 11 ptin) (cons 40 hgt) (cons 50 ang) (cons 1 str) (cons 72 j72) (cons 73 j73) ) ) ) (defun drln (ptst ptend / ) (entmakex (list (cons 0 "LINE") (cons 10 ptst) (cons 11 ptend) ) ) ) (defun drec (pll plr pur pul / ) (entmake (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 4) ;Number of vertices (cons 70 1) ; closed = 1,open=0 (cons 10 pll) (cons 10 plr) (cons 10 pur) (cons 10 pul) ) ) ) ; jetzt gehts los ; (defun C:KoordinatenRand_Ms( / alterror sblip scmd sosmode al anz x axl zen_af zen_af_x zen_af_y zen_modw zen_mod_xw zen_mod_yw br_af h_af h_mod affakt br_mod alpha element punkte liun_mb liob_mb reun_mb reob_mb liun_mb_x liob_mb_x reun_mb_x reob_mb_x liun_mb_y liob_mb_y reun_mb_y reob_mb_y startx starty delta_l delta_m cy_af richtg textht textri textausri textausri1 cx_mb minx maxx delta_m1 cx_af ctext p1 p2 pt cy_mb miny maxy txtpos txtlndist upnum dwnum textri2 pt1 txtpos2 plent co-ord ptx1 pty1 ptx2 pty2 ptx3 pty3 ptx4 pty4 minxm minym maxxm maxym jstt72 jstt73 jstb72 jstb73 txtlen lenctext vppt1 vppt2 vppt3 vppt4 ) (vl-load-com) (setq alterror *error*) (setq *error* my_error) (command "_undo" "_mark") (setq textht (getvar "TEXTSIZE")) (setq textht2 (* textht 0.75));;char (number) width to calculate line length (setq textht3 (* textht 0.296));; offset distance for text with top justification (print "Ansichtsfensterkoordinaten") ; ; ein paar vorbereitungen ; (setq sblip (getvar "blipmode")) (setq scmde (getvar "cmdecho")) (setq sosmode (getvar "osmode")) (setq sangbase (getvar "angbase")) (setq sangdir (getvar "angdir")) (setq saunits (getvar "aunits")) (setvar "blipmode" 0) (setvar "cmdecho" 0) (setvar "osmode" 0) (setvar "angbase" 0) (setvar "angdir" 0) (setvar "aunits" 0) ; waehle Fenster (prompt "\nSelect Rectangle Frame: ") (setq anz 0 al (ssget '((0 . "LWPOLYLINE")))) ;(setq anz (sslength al)) (if al (setq anz (sslength al)) (print "no rectangle selected")) (setq x 0) (while (< x anz) (setq axl (entget (ssname al x))) ; ; pruefen ob ansichtsfenster ; (if (= "LWPOLYLINE" (cdr (assoc 0 axl))) (progn (setq co-ord (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget (ssname al x))))) ;make list of the rectangle points (setq ptx1 (car (nth 0 co-ord))) (setq pty1 (cadr (nth 0 co-ord))) (setq ptx2 (car (nth 1 co-ord))) (setq pty2 (cadr (nth 1 co-ord))) (setq ptx3 (car (nth 2 co-ord))) (setq pty3 (cadr (nth 2 co-ord))) (setq ptx4 (car (nth 3 co-ord))) (setq pty4 (cadr (nth 3 co-ord))) (setq minxm (min ptx1 ptx2 ptx3 ptx4)) (setq minym (min pty1 pty2 pty3 pty4)) (setq maxxm (max ptx1 ptx2 ptx3 ptx4)) (setq maxym (max pty1 pty2 pty3 pty4)) (setq alpha 0) ;Rectangle twist angle ; ; ; eckpunkte ansichtsfenster (annahme nicht gedreht) (vertices viewport (assuming not rotated)) ; ; ; OK bis hier, nun koordinaten der Eckpunkte fuer Modellbereich ermitteln (OK up to here, now determine the coordinates of the corner points for the model area) ; ; dafür haben wir im lisp forum etwas gefunden (We found something for this in the lisp forum) (setq liun_mb (list minxm minym)) ;lower left model space point (setq reun_mb (list maxxm minym)) ;lower right model space point (setq reob_mb (list maxxm maxym)) ;upper right model space point (setq liob_mb (list minxm maxym)) ;upper left model space point (setq liun_mb_x (car liun_mb)) ;lower left model space point X liun_af_x (setq liun_mb_y (cadr liun_mb)) ;lower left model space point Y liun_af_y (setq liob_mb_x (car liob_mb)) ;upper left model space point X liob_af_x (setq liob_mb_y (cadr liob_mb)) ;upper left model space point Y liob_af_y (setq reun_mb_x (car reun_mb)) ;lower right model space point X reun_af_x (setq reun_mb_y (cadr reun_mb)) ;lower right model space point Y reun_af_y (setq reob_mb_x (car reob_mb)) ;upper right model space point X reob_af_x (setq reob_mb_y (cadr reob_mb)) ;upper right model space point Y reob_af_y ; ; Ausgabe Extremwerte und Abfrage Startwerte und Schrittweiten ; (print "Mininmal- und Maximalwert x ") (princ (min liun_mb_x liob_mb_x reun_mb_x reob_mb_x)) (princ " ") (princ " ") (princ (max liun_mb_x liob_mb_x reun_mb_x reob_mb_x)) (print "Mininmal- und Maximalwert y") (princ (min liun_mb_y liob_mb_y reun_mb_y reob_mb_y)) (princ " ") (princ " ") (princ (max liun_mb_y liob_mb_y reun_mb_y reob_mb_y)) (setq optminx (/ (min liun_mb_x liob_mb_x reun_mb_x reob_mb_x) 100)) (setq optminx (* (atof (rtos optminx 2 0)) 100)) (setq optminy (/ (min liun_mb_y liob_mb_y reun_mb_y reob_mb_y) 100)) (setq optminy (* (atof (rtos optminy 2 0)) 100)) ;(terpri) (setq startx (getreal (strcat "\nSpecify starting value for x coordinates: <" (rtos optminx 2 2) ">"))) (if (= startx nil) (setq startx optminx) ) (setq starty (getreal (strcat "\nSpecify starting value for x coordinates: <" (rtos optminy 2 2) ">"))) (if (= starty nil) (setq starty optminy) ) ;(initget 3) (setq delta_l (getreal "\nSpecify step size for coordinates: <100.00>" )) (if (= delta_l nil) (setq delta_l 100) ) (setq txtpos (getreal "Specify text dist. from frame: : <1.00> ")) (if (= txtpos nil) (setq txtpos 1) ) (setq textht1 txtpos);; line exstention from the end of the longest number - center the longest number on the line(* textht 0.25));; (setq lraussen (= (antwort "\nCoordinates inside-I/outside-A of the AF [I/A] :" "Innen" "Aussen") "A")) ;;;; Create the frames ;; find max text length for X value (setq l1 (strlen (rtos (min liun_mb_x liob_mb_x reun_mb_x reob_mb_x) 2 0))) (setq l2 (strlen (rtos (max liun_mb_x liob_mb_x reun_mb_x reob_mb_x) 2 0))) (setq lmax (max l1 l2)) (if (< lmax 7) (setq txtlenx 3) (setq txtlenx (- lmax 3)) ) (setq txtlndistx (+ txtpos textht1 (* txtlenx textht2)));;offset value for X ;; find max text length for Y value (setq l1 (strlen (rtos (min liun_mb_y liob_mb_y reun_mb_y reob_mb_y) 2 0))) (setq l2 (strlen (rtos (max liun_mb_y liob_mb_y reun_mb_y reob_mb_y) 2 0))) (setq lmax (max l1 l2)) (if (< lmax 7) (setq txtleny 3) (setq txtleny (- lmax 3)) ) (setq txtlndisty (+ txtpos textht1 (* txtleny textht2)));;offset value for Y (if lraussen ;; Frame Outside (progn (setq vppt1 (list (- liun_mb_x txtlndisty) (- liun_mb_y txtlndistx) 0)) ;lower left viewport point (setq vppt2 (list (+ reun_mb_x txtlndisty) (- reun_mb_y txtlndistx) 0)) ;lower right viewport point (setq vppt3 (list (+ reob_mb_x txtlndisty) (+ reob_mb_y txtlndistx) 0)) ;upper right viewport point (setq vppt4 (list (- liun_mb_x txtlndisty) (+ liob_mb_y txtlndistx) 0)) ;upper left viewport point ) (progn ; Frame inside (setq vppt1 (list (+ liun_mb_x txtlndisty) (+ liun_mb_y txtlndistx) 0)) ;lower left viewport point (setq vppt2 (list (- reun_mb_x txtlndisty) (+ reun_mb_y txtlndistx) 0)) ;lower right viewport point (setq vppt3 (list (- reob_mb_x txtlndisty) (- reob_mb_y txtlndistx) 0)) ;upper right viewport point (setq vppt4 (list (+ liun_mb_x txtlndisty) (- liob_mb_y txtlndistx) 0)) ;upper left viewport point ) );;end if (drec vppt1 vppt2 vppt3 vppt4) ; ; Werte pruefen und setzen (lassen wir noch offen) ; ; ; jetzt gehts richtig los ; ; unterer Rand, x werte ; (setq delta_m (- reun_mb_x liun_mb_x)) ; dargestellte Koord.diff im Modellb. (Coord.diff shown in the model.) (setq cy_af liun_mb_y) (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.)))) ; Richtg. der Linie in Abh. von Drehung MB in AF (Direction the line depending on rotation MB in AF) (setq richtg (- alpha (/ pi 2.))) (setq richtg (+ alpha (/ pi 2.))) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) ; nur Richtung 0 .. 2pi zulaessig (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (if (< richtg (/ pi 2)) ; Textrichtg. in Abh. von Linienrichtg. (progn (setq textri (/ (* richtg 180 ) pi)) (setq textausri (if lraussen "br" "bl")) ) ; end progn (progn (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "bl" "br")) ) ; end progn ) ; end if (if lraussen (setq richtg (+ richtg pi))) (setq cx_mb startx) (setq minx (min liun_mb_x reun_mb_x)) ; es kann auch in negativer Richtung verlaufen (setq maxx (max liun_mb_x reun_mb_x)) (while (<= cx_mb minx) ; ersten auf Rand im MB vorh. Wert ermitteln (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb (while (< cx_mb maxx) (setq delta_m1 (- cx_mb liun_mb_x)) ; Streckenverhaeltnisse (setq cx_af (+ liun_mb_x delta_m1)) (setq ctext (rtos cx_mb 2 0)) (setq p1 (list cx_af cy_af)) (if (= (- (strlen ctext) 3) 0) (setq upnum "0") (setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number ) ;(setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number (setq dwnum (substr ctext (- (strlen ctext) 2) (strlen ctext))) ;(setq txtlen (max (strlen upnum) (strlen dwnum))) ;(setq txtlndist (+ txtpos textht1 (* txtlen textht2))) (setq p2 (polar p1 richtg txtlndistx)) (setq pt (polar p1 richtg (/ txtlndistx 2))) (drln p1 p2) ;(command "_.line" p1 p2 "") (setq textri2 (- textri 90)) (setq pt1 (polar pt (* (/ textri2 180) pi) textht3)) (if ( = textausri "br");jstt72 jstt73 jstb72 jstb73 (progn ;br (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tr") ) (progn ;bl (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tl") ) ) (Txtin pt textht upnum jstt72 jstt73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ang (Txtin pt1 textht dwnum jstb72 jstb73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ;(command "_.text" "_j" textausri pt textht textri upnum) ;(command "_.text" "_j" textausri1 pt1 textht textri dwnum) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb ; oberer Rand, x werte ; (setq delta_m (- reob_mb_x liob_mb_x)) (setq cy_af liob_mb_y) (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.)))) (setq richtg (+ alpha (/ pi 2.))) (setq richtg (- alpha (/ pi 2.))) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (if (< richtg (* pi 1.5)) (progn (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "bl" "br")) ) ; end progn (progn (setq textri (/ (* richtg 180 ) pi)) (setq textausri (if lraussen "br" "bl")) ) ; end progn ) ; end if (if lraussen (setq richtg (+ richtg pi))) (setq cx_mb startx) (setq minx (min liob_mb_x reob_mb_x)) (setq maxx (max liob_mb_x reob_mb_x)) (while (<= cx_mb minx) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb (while (< cx_mb maxx) (setq delta_m1 (- cx_mb liob_mb_x)) (setq cx_af (+ liob_mb_x delta_m1)) (setq ctext (rtos cx_mb 2 0)) (setq p1 (list cx_af cy_af)) (if (= (- (strlen ctext) 3) 0) (setq upnum "0") (setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number ) ;(setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number (setq dwnum (substr ctext (- (strlen ctext) 2) (strlen ctext))) ;(setq txtlen (max (strlen upnum) (strlen dwnum))) ;(setq txtlndist (+ txtpos textht1 (* txtlen textht2))) (setq p2 (polar p1 richtg txtlndistx)) (setq pt (polar p1 richtg ( / txtlndistx 2))) (drln p1 p2) ;(command "_.line" p1 p2 "") (setq textri2 (- textri 90)) (setq pt1 (polar pt (* (/ textri2 180) pi) textht3)) (if ( = textausri "br");jstt72 jstt73 jstb72 jstb73 (progn ;br (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tr") ) (progn ;bl (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tl") ) ) (Txtin pt textht upnum jstt72 jstt73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ang (Txtin pt1 textht dwnum jstb72 jstb73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ;(command "_.text" "_j" textausri pt textht textri upnum) ;(if ( = textausri "br") ; (setq textausri1 "tr") ; (setq textausri1 "tl") ;) ;(command "_.text" "_j" textausri1 pt1 textht textri dwnum) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb ; linker Rand, x werte ; (setq delta_m (- liob_mb_x liun_mb_x)) (setq cx_af liun_mb_x) (if (> alpha pi) (setq richtg (+ alpha (/ pi 2.))) (setq richtg (- alpha (/ pi 2.))) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textri (/ (* richtg 180 ) pi)) ; (setq textausri "bl") (setq textausri (if lraussen "br" "bl")) (if lraussen (setq richtg (+ richtg pi))) (setq cx_mb startx) (setq minx (min liob_mb_x liun_mb_x)) (setq maxx (max liob_mb_x liun_mb_x)) (while (<= cx_mb minx) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb (while (< cx_mb maxx) (setq delta_m1 (- cx_mb liun_mb_x)) (setq cy_af (+ liun_mb_y delta_m1)) (setq ctext (rtos cx_mb 2 0)) (setq p1 (list cx_af cy_af)) (if (= (- (strlen ctext) 3) 0) (setq upnum "0") (setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number ) ;(setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number (setq dwnum (substr ctext (- (strlen ctext) 2) (strlen ctext))) ;(setq txtlen (max (strlen upnum) (strlen dwnum))) ;(setq txtlndist (+ txtpos textht1 (* txtlen textht2))) (setq p2 (polar p1 richtg txtlndistx)) (setq pt (polar p1 richtg ( / txtlndistx 2))) (drln p1 p2) ;(command "_.line" p1 p2 "") (setq textri2 (- textri 90)) (setq pt1 (polar pt (* (/ textri2 180) pi) textht3)) (if ( = textausri "br");jstt72 jstt73 jstb72 jstb73 (progn ;br (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tr") ) (progn ;bl (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tl") ) ) (Txtin pt textht upnum jstt72 jstt73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ang (Txtin pt1 textht dwnum jstb72 jstb73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ;(command "_.text" "_j" textausri pt textht textri upnum) ;(if ( = textausri "br") ; (setq textausri1 "tr") ; (setq textausri1 "tl") ;) ;(command "_.text" "_j" textausri1 pt1 textht textri dwnum) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb ; rechter Rand, x werte ; (setq delta_m (- reob_mb_x reun_mb_x)) (setq cx_af reun_mb_x) (if (< alpha pi) (setq richtg (+ alpha (/ pi 2.))) (setq richtg (- alpha (/ pi 2.))) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "bl" "br")) (if lraussen (setq richtg (+ richtg pi))) (setq cx_mb startx) (setq minx (min reob_mb_x reun_mb_x)) (setq maxx (max reob_mb_x reun_mb_x)) (while (<= cx_mb minx) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb (while (< cx_mb maxx) (setq delta_m1 (- cx_mb reun_mb_x)) (setq cy_af (+ reun_mb_y delta_m1)) (setq ctext (rtos cx_mb 2 0)) (setq p1 (list cx_af cy_af)) (if (= (- (strlen ctext) 3) 0) (setq upnum "0") (setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number ) ;(setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number (setq dwnum (substr ctext (- (strlen ctext) 2) (strlen ctext))) ;(setq txtlen (max (strlen upnum) (strlen dwnum))) ;(setq txtlndist (+ txtpos textht1 (* txtlen textht2))) (setq p2 (polar p1 richtg txtlndistx)) (setq pt (polar p1 richtg ( / txtlndistx 2))) (drln p1 p2) ;(command "_.line" p1 p2 "") (setq textri2 (- textri 90)) (setq pt1 (polar pt (* (/ textri2 180) pi) textht3)) (if ( = textausri "br");jstt72 jstt73 jstb72 jstb73 (progn ;br (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tr") ) (progn ;bl (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tl") ) ) (Txtin pt textht upnum jstt72 jstt73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ang (Txtin pt1 textht dwnum jstb72 jstb73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ;(command "_.text" "_j" textausri pt textht textri upnum) ;(if ( = textausri "br") ; (setq textausri1 "tr") ; (setq textausri1 "tl") ;) ;(command "_.text" "_j" textausri1 pt1 textht textri dwnum) (setq cx_mb (+ cx_mb delta_l)) ) ; end while cx_mb ; linker Rand, y werte ; (setq delta_m (- liob_mb_y liun_mb_y)) (setq cx_af liun_mb_x) (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.)))) (setq richtg (+ pi alpha)) (setq richtg (+ alpha)) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textausri (if lraussen "br" "bl")) (setq textri (/ (* richtg 180 ) pi)) (if lraussen (setq richtg (+ richtg pi))) (setq cy_mb starty) (setq miny (min liob_mb_y liun_mb_y)) (setq maxy (max liob_mb_y liun_mb_y)) (while (<= cy_mb miny) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb (while (< cy_mb maxy) (setq delta_m1 (- cy_mb liun_mb_y)) (setq cy_af (+ liun_mb_y delta_m1)) (setq ctext (rtos cy_mb 2 0)) (setq p1 (list cx_af cy_af)) (if (= (- (strlen ctext) 3) 0) (setq upnum "0") (setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number ) ;(setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number (setq dwnum (substr ctext (- (strlen ctext) 2) (strlen ctext))) ;(setq txtlen (max (strlen upnum) (strlen dwnum))) ;(setq txtlndist (+ txtpos textht1 (* txtlen textht2))) (setq p2 (polar p1 richtg txtlndisty)) (setq pt (polar p1 richtg ( / txtlndistx 2))) (drln p1 p2) ;(command "_.line" p1 p2 "") (setq textri2 (- textri 90)) (setq pt1 (polar pt (* (/ textri2 180) pi) textht3)) (if ( = textausri "br");jstt72 jstt73 jstb72 jstb73 (progn ;br (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tr") ) (progn ;bl (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tl") ) ) (Txtin pt textht upnum jstt72 jstt73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ang (Txtin pt1 textht dwnum jstb72 jstb73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ;(command "_.text" "_j" textausri pt textht textri upnum) ;(if ( = textausri "br") ; (setq textausri1 "tr") ; (setq textausri1 "tl") ;) ;(command "_.text" "_j" textausri1 pt1 textht textri dwnum) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb ; rechter Rand, y werte ; (setq delta_m (- reob_mb_y reun_mb_y)) (setq cx_af reun_mb_x) (if (and (> alpha (/ pi 2.)) (< alpha (* 3 (/ pi 2.)))) (setq richtg (+ alpha)) (setq richtg (+ pi alpha)) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "bl" "br")) (if lraussen (setq richtg (+ richtg pi))) (setq cy_mb starty) (setq miny (min reun_mb_y reob_mb_y)) (setq maxy (max reun_mb_y reob_mb_y)) (while (<= cy_mb miny) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb (while (< cy_mb maxy) (setq delta_m1 (- cy_mb reun_mb_y)) (setq cy_af (+ reun_mb_y delta_m1)) (setq ctext (rtos cy_mb 2 0)) (setq p1 (list cx_af cy_af)) (if (= (- (strlen ctext) 3) 0) (setq upnum "0") (setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number ) ;(setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number (setq dwnum (substr ctext (- (strlen ctext) 2) (strlen ctext))) ;(setq txtlen (max (strlen upnum) (strlen dwnum))) ;(setq txtlndist (+ txtpos textht1 (* txtlen textht2))) (setq p2 (polar p1 richtg txtlndisty)) (setq pt (polar p1 richtg ( / txtlndistx 2))) (drln p1 p2) ;(command "_.line" p1 p2 "") (setq textri2 (- textri 90)) (setq pt1 (polar pt (* (/ textri2 180) pi) textht3)) (if ( = textausri "br");jstt72 jstt73 jstb72 jstb73 (progn ;br (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tr") ) (progn ;bl (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tl") ) ) (Txtin pt textht upnum jstt72 jstt73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ang (Txtin pt1 textht dwnum jstb72 jstb73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ;(command "_.text" "_j" textausri pt textht textri upnum) ;(if ( = textausri "br") ; (setq textausri1 "tr") ; (setq textausri1 "tl") ;) ;(command "_.text" "_j" textausri1 pt1 textht textri dwnum) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb ; unterer Rand, y werte ; (setq delta_m (- reun_mb_y liun_mb_y)) (setq cy_af liun_mb_y) (if (< alpha pi) (setq richtg (+ alpha)) (setq richtg (+ pi alpha)) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (if (< richtg (/ pi 2)) (progn (setq textri (/ (* richtg 180 ) pi)) (setq textausri (if lraussen "br" "bl")) ) ; end progn (progn (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "bl" "br")) ) ; end progn ) ; end if (if lraussen (setq richtg (+ richtg pi))) (setq cy_mb starty) (setq miny (min liun_mb_y reun_mb_y)) (setq maxy (max liun_mb_y reun_mb_y)) (while (<= cy_mb miny) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb (while (< cy_mb maxy) (setq delta_m1 (- cy_mb liun_mb_y)) (setq cx_af (+ liun_mb_x delta_m1)) (setq ctext (rtos cy_mb 2 0)) (setq p1 (list cx_af cy_af)) (if (= (- (strlen ctext) 3) 0) (setq upnum "0") (setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number ) ;(setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number (setq dwnum (substr ctext (- (strlen ctext) 2) (strlen ctext))) ;(setq txtlen (max (strlen upnum) (strlen dwnum))) ;(setq txtlndist (+ txtpos textht1 (* txtlen textht2))) (setq p2 (polar p1 richtg txtlndisty)) (setq pt (polar p1 richtg ( / txtlndistx 2))) (drln p1 p2) ;(command "_.line" p1 p2 "") (setq textri2 (- textri 90)) (setq pt1 (polar pt (* (/ textri2 180) pi) textht3)) (if ( = textausri "br");jstt72 jstt73 jstb72 jstb73 (progn ;br (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tr") ) (progn ;bl (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tl") ) ) (Txtin pt textht upnum jstt72 jstt73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ang (Txtin pt1 textht dwnum jstb72 jstb73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ;(command "_.text" "_j" textausri pt textht textri upnum) ;(if ( = textausri "br") ; (setq textausri1 "tr") ; (setq textausri1 "tl") ;) ;(command "_.text" "_j" textausri1 pt1 textht textri dwnum) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb ; oberer Rand, y werte ; (setq delta_m (- reob_mb_y liob_mb_y)) (setq cy_af liob_mb_y) (if (< alpha pi) (setq richtg (+ pi alpha)) (setq richtg (+ alpha)) ) ; end if (if (< richtg 0) (setq richtg (+ richtg pi pi))) (if (> richtg (* 2 pi)) (setq richtg (- richtg pi pi))) (if (< richtg (* pi 1.5)) (progn (setq textri (/ (* (- richtg pi) 180 ) pi)) (setq textausri (if lraussen "bl" "br")) ) ; end progn (progn (setq textri (/ (* richtg 180 ) pi)) (setq textausri (if lraussen "br" "bl")) ) ; end progn ) ; end if (if lraussen (setq richtg (+ richtg pi))) (setq cy_mb starty) (setq miny (min liob_mb_y reob_mb_y)) (setq maxy (max liob_mb_y reob_mb_y)) (while (<= cy_mb miny) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb (while (< cy_mb maxy) (setq delta_m1 (- cy_mb liob_mb_y)) (setq cx_af (+ liob_mb_x delta_m1)) (setq ctext (rtos cy_mb 2 0)) (setq p1 (list cx_af cy_af)) (if (= (- (strlen ctext) 3) 0) (setq upnum "0") (setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number ) ;(setq upnum (substr ctext 1 (- (strlen ctext) 3))) ;top number (setq dwnum (substr ctext (- (strlen ctext) 2) (strlen ctext))) ;(setq txtlen (max (strlen upnum) (strlen dwnum))) ;(setq txtlndist (+ txtpos textht1 (* txtlen textht2))) (setq p2 (polar p1 richtg txtlndisty)) (setq pt (polar p1 richtg ( / txtlndistx 2))) (drln p1 p2) ;(command "_.line" p1 p2 "") (setq textri2 (- textri 90)) (setq pt1 (polar pt (* (/ textri2 180) pi) textht3)) (if ( = textausri "br");jstt72 jstt73 jstb72 jstb73 (progn ;br (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tr") ) (progn ;bl (setq jstt72 1) ;center (setq jstt73 1) ;bottom (setq jstb72 1) ;center (setq jstb73 3) ;top (setq textausri1 "tl") ) ) (Txtin pt textht upnum jstt72 jstt73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ang (Txtin pt1 textht dwnum jstb72 jstb73 (* (/ textri 180) pi)) ;ptin hgt str j72 j73 ;(command "_.text" "_j" textausri pt textht textri upnum) ;(if ( = textausri "br") ; (setq textausri1 "tr") ; (setq textausri1 "tl") ;) ;(command "_.text" "_j" textausri1 pt1 textht textri dwnum) (setq cy_mb (+ cy_mb delta_l)) ) ; end while cy_mb ) ;end progn ) ; end if viewport (setq x (1+ x)) ) ; ; Ausgangsbedingungen wieder herstellen ; (setvar "blipmode" sblip) (setvar "cmdecho" scmde) (setvar "osmode" sosmode) (setvar "angbase" sangbase) (setvar "angdir" sangdir) (setvar "aunits" saunits) (setq *error* alterror) (prompt "Coordinates set") (princ) )

If you want to change the mask's color or size, look for the variables "color" and "tamañoMascara" and change their values. Currently, their values are 1 (red) and 1.2, respectively.

Perhaps this will help you (defun strpto (aa / largo) (setq largo (strlen aa)) (cond ((< largo 4) aa) ((= largo 6) (strcat (substr aa 1 3) "." (substr aa 4 3))) ((= largo 7) (strcat (substr aa 1 1) "." (substr aa 2 3) "." (substr aa 5 3) ) ) (t aa) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; DatosLineas : obtiene los coeficientes necesarios para determinar las ;; rectas que definen el area a cuadricular. Las cuales son ;; de la forma : a*x + b*y = c ;; (Defun DatosLineas (p1 p2 p3 p4) (setq a1 (- (cadr p2) (cadr p1)) a2 (- (cadr p4) (cadr p2)) a3 (- (cadr p3) (cadr p4)) a4 (- (cadr p1) (cadr p3)) b1 (- (car p1) (car p2)) b2 (- (car p2) (car p4)) b3 (- (car p4) (car p3)) b4 (- (car p3) (car p1)) c1 (- (* (car p1) (cadr p2)) (* (car p2) (cadr p1))) c2 (- (* (car p2) (cadr p4)) (* (car p4) (cadr p2))) c3 (- (* (car p4) (cadr p3)) (* (car p3) (cadr p4))) c4 (- (* (car p3) (cadr p1)) (* (car p1) (cadr p3))) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Punto de la recta dada por a,b,c dada la cordenada Y ;; (Defun CalculaX (a b c y) (if (= 0.0 a) ; no hay interseccion nil (/ (- c (* b y)) a) ) ) (Defun IntersecX (/ l lista) (setq l () lista (list (CalculaX a1 b1 c1 startY) (CalculaX a2 b2 c2 startY) (CalculaX a3 b3 c3 startY) (CalculaX a4 b4 c4 startY) ) ) (while (/= lista nil) (setq x (car lista)) (if (and (/= x nil) (<= x maxX) (>= x minX)) (setq l (append l (list x))) ) (setq lista (cdr lista)) ) (list (min (car l) (cadr l)) (max (car l) (cadr l))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Interseccion dada la cordenada X ;; (Defun CalculaY (a b c x) (if (= 0.0 b) ; no hay interseccion nil (/ (- c (* a x)) b) ) ) (Defun IntersecY (/ l lista) (setq l () lista (list (CalculaY a1 b1 c1 startX) (CalculaY a2 b2 c2 startX) (CalculaY a3 b3 c3 startX) (CalculaY a4 b4 c4 startX) ) ) (while (/= lista nil) (setq y (car lista)) (if (and (/= y nil) (<= y maxY) (>= y minY)) (setq l (append l (list y))) ) (setq lista (cdr lista)) ) (list (min (car l) (cadr l)) (max (car l) (cadr l))) ) (defun dameEsquinas (e / le lp) (if (= (cdr (assoc 0 (setq le (entget e)))) "LWPOLYLINE") (foreach l le (if (= (car l) 10) (setq lp (cons (cdr l) lp)) ) ) ) (if lp (vl-sort lp '(lambda(a b) (< (car a) (car b))))) ) (defun comando (tipobjeto punto altura rotacion texto j / color tamañoMascara) (setq color 1 tamañoMascara 1.2) (cond ((= tipobjeto "MTEXT") (entmake (list '(0 . "MTEXT") '(8 . "0") '(100 . "AcDbEntity") ;;; '(410 . "Model") '(100 . "AcDbMText") (list 10 (+ x1 dl) (+ startY dh) 0.0) ;;; (cons 10 punto) (cons 40 altura) (cons 41 (* altura (strlen texto))) (cons 71 (if j 9 (getvar "TEXTALIGNMODE"))) (cons 1 texto) '(7 . "Standard") ;;; '(210 0.0 0.0 1.0) ;(11 0.896666 0.442707 0.0) ;(42 . 236.19) (cons 43 altura) (cons 50 (angtof (cond ((eq (setq p (type rotacion)) 'INT) (itoa rotacion)) ((eq p 'STR) p) ((eq p 'REAL) (rtos p 2 2)) ) ) ) '(90 . 1) (cons 63 (if color color 1)) (cons 45 (if tamañoMascara tamañoMascara 1.2)) '(441 . 0) ) ) ) ((= tipobjeto "TEXT") (entmake (list '(0 . "TEXT") '(8 . "0") (cons 40 altura) (cons 1 texto) (list 10 (+ x1 dl) (+ startY dh) 0.0) (cons 50 (angtof (cond ((eq (setq p (type rotacion)) 'INT) (itoa p)) ((eq p 'STR) p) ((eq p 'REAL) (rtos p 2 2)) ) ) ) ) ) ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; Programa principal ;; (Defun c:grilla (/ p1 p2 p3 p4 paux incx incy l h n maldato base alfa startX startY minX minY maxX maxY ) (setvar "CMDECHO" 0) (command "_.undo" "_begin") (command "osnap" "off") (command "units" "2" "3" "3" "4" "e" "n") (command "LAYER" "M" "TO-GRILLA" "C" "8" "" "") (command "style" "romand" "romand" 0 1 0 "N" "N" "N") (setq incrx 0) ;;; (setq p1 (getpoint "\nIngrese un vertice de la region ") ;;; p2 (getpoint p1 "\nIngrese el otro vertice ") ;;; ) ;;; (command "LINE" p1 p2 "") (if (not (setq e (car (entsel "\nSelecciona el marco para la grilla...")))) (exit) ) (setq l (dameEsquinas e) p1 (car l) p2 (cadr l) p3 (caddr l) l nil ) (if (> (cadr p1) (cadr p2)) ; siempre el p1 abajo (setq paux p1 p1 p2 p2 paux ) ) (setq ;p3 (getpoint p1 "\nIngrese punto para Ancho de la region ") l (distance p1 p3) ; calculo de puntos p3 y p4 , paralelos alfa (angle p1 p2) ; a p1 y p2 a distancia l alfa (+ (/ pi 2) alfa) ) (if (> (car p3) (car p1)) (setq alfa (+ pi alfa)) ) (if (= (car p1) (car p3)) (if (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1))) 0.0) (setq alfa (+ pi alfa)) ) ) (setq p3 (list (+ (car p1) (* l (cos alfa))) (+ (cadr p1) (* l (sin alfa))) ) p4 (list (+ (car p2) (* l (cos alfa))) (+ (cadr p2) (* l (sin alfa))) ) ) (command "LINE" p1 p2 p4 p3 "C") ; marco exterior (if (< (cadr p3) (cadr p1)) ; punto1 siempre mas bajo (setq paux p1 p1 p3 p3 paux paux p2 p2 p4 p4 paux ) ) (setq minX (min (car p2) (car p3)) maxX (max (car p2) (car p3)) minY (cadr p1) maxY (cadr p4) l (- maxX minX) h (- maxY minY) malDato 1 ) (while (= malDato 1) (setq incx (getreal "\nIncremento malla (m) :")) (if (< (abs (/ l 3)) incrx) (print "\nIncremento muy grande") (setq malDato 0) ) ) (setq incy incx) (setq n (fix (/ minX incx)) ; posiciones donde comenzar startX (* (1+ n) incx) ; el cuadriculado n (fix (/ minY incy)) ; tanto en X como en Y startY (* (1+ n) incy) largoMax (max (distance p1 p3) ; el largo maximo de la region (distance p1 p4) ) ) (if (< minX 0) (setq startX (- startX incx)) ) (if (< minY 0) (setq startY (- startY incy)) ) (setq ff (getreal "\nIngrese Alto (mm) :")) (setq escala (getreal "\nEscala : ")) (setq alto (* (/ ff 1000) escala)) ; alto de los caracteres (setq angP1P3 (angle p1 p3) angP1P2 (angle p1 p2) angBorde (min (abs angP1P3) (abs angP1P2)) dh (min (/ incx 40.0) (/ incy 40.0)) x1 minX ; el caso en que no hay que rotar x2 maxX y1 minY y2 maxY ) (if (or (= (cadr p1) (cadr p2)) (= (car p1) (car p3)) (= (car p1) (car p2)) ) (setq revisar 0 dl (min (/ incx 30.0) (/ incy 30.0)) ) (setq revisar 1 dl (* (* alto (/ (cos angBorde) (sin angBorde))) 2) ) ) (DatosLineas p1 p2 p3 p4) (while (< startY maxY) (if (= revisar 1) (setq ptos (IntersecX) x1 (car ptos) x2 (cadr ptos) ) ) (setq coordY (rtos startY 2 0) coordY (strcat "N-" (strpto coordY)) ) (command "LINE" (list x1 startY) (list x2 startY) "") (cond ((> (- maxY startY) (* 2 alto)) ;;; (command "TEXT" ;;; (list (+ x1 dl) (+ startY dh)) ;;; alto ;;; 0 ;;; coordY ;;; ) (comando "MTEXT" (list (+ x1 dl) (+ startY dh)) alto 0 coordY nil) ;;; (command "TEXT" ;;; "R" ;;; (list (- x2 dl) (+ startY dh)) ;;; alto ;;; 0 ;;; coordY ;;; ) (comando "MTEXT" (list (- x2 dl) (+ startY dh)) alto 0 coordY T) ) ) (setq startY (+ startY incy)) ) (while (< startX maxX) (if (= revisar 1) (setq ptos (IntersecY) y1 (car ptos) y2 (cadr ptos) ) ) (setq coordX (rtos startX 2 0) coordX (strcat "E-" (strpto coordX)) ) (command "LINE" (list startX y1) (list startX y2) "") (cond ((> (- startX minX) (* 2 alto)) ;;; (command "TEXT" ;;; (list (- startX dh) (+ y1 dl)) ;;; alto ;;; 100 ;;; coordX ;;; ) (comando "MTEXT" (list (- startX dh) (+ y1 dl)) alto 0 coordX nil) ;;; (command "TEXT" ;;; "R" ;;; (list (- startX dh) (- y2 dl)) ;;; alto ;;; 100 ;;; coordX ;;; ) (comando "MTEXT" (list (- startX dh) (- y2 dl)) alto 0 coordX T) ) ) (setq startX (+ startX incx)) ) (if (> (distance p1 p3) (distance p1 p2)) (setq alfa angP1P3) (setq alfa angP1P2) ) (if (or (/= alfa pi) (/= alfa 0.0)) (setq alfarad (* -1 alfa) alfa (* -1 (/ (* 200 alfa) pi)) p4 (list (- (* (car p4) (cos alfarad)) (* (cadr p4) (sin alfarad))) (+ (* (car p4) (sin alfarad)) (* (cadr p4) (cos alfarad))) ) p1 (list (- (* (car p1) (cos alfarad)) (* (cadr p1) (sin alfarad))) (+ (* (car p1) (sin alfarad)) (* (cadr p1) (cos alfarad))) ) base (list 0.0 0.0) ; el origen ) ) (command "_.undo" "end") (command "_.undo" "auto" "on") ;; (command "units" "2" "3" "3" "4" "n" "y") )

Thinking I understood that one.... In my attempt (sorry folks haven't had a chance to look at it this week yet) I was half way here, created a temp poly line mid point between poly 1 end points and closest on poly 2. Created a list of points mid point from poly 2 to closest point on poly 1 (the reverse) then ent mod the temp poly adding in new points as required... it didn't work 100%. Tried to think how to combine the 2 lists of points (1 to 2, 2 to 1). Point at Param might be the one to go for. Spanner in the works... what happens if the end points are not aligned, example closed polylines, first point on poly 1 say at the 12:00 position, first point on poly 2 say at 3:00 position? - think it will work OK

See if this works will tweek it tonight if something throws error. Modified version of my last code Ask user to select first and 2nd polyline Find mid points from each vertex of poly1 to poly 2 with vlax-curve-getClosestPointTo Adds those points to a dotted pair with the vertex number Creates a temp polyine with those points Find minpoints from each vertex of poly2 to poly one with vlax-curve-getClosestPointTo Processed the 2nd list of points using vlax-curve-getClosestPointTo to temp polyline Using that with vlax-curve-getParamatpoint will tell where on the tempoly if falls Sort polylist by the parma so they will be in order and removing the parama so only point data is left Delete temp polyline Create new mid polyline with all points in right order. Stuff that is doing the heavy lifting is vlax-curve-getClosestPoint and vlax-curve-getParamatpoint. this will work with polylines with arc's but will only generate a mid polyline using straight lines. Everything you post they don't seem to have any arcs so you should be good. ;;----------------------------------------------------------------------------;; ;; POLY AVERAGE path between polylines, Finds the mid path (defun c:PA () (C:POLYAVG)) (defun c:POLYAVG (/ ent1 ent2 i tol ptv ptc par mid pts1 pts2 polylst tempoly) (setq ent1 (car (entsel "\nSelect first polyline: "))) (if (not (and ent1 (= (cdr (assoc 0 (entget ent1))) "LWPOLYLINE"))) (progn (princ "\nInvalid 1st selection.") (exit) ) (setq ent1 (vlax-ename->vla-object ent1)) ) (setq ent2 (car (entsel "\nSelect 2nd polyline: "))) (if (not (and ent2 (= (cdr (assoc 0 (entget ent2))) "LWPOLYLINE"))) (progn (princ "\nInvalid first selection.") (exit) ) (setq ent2 (vlax-ename->vla-object ent2)) ) (if (and ent1 ent2) (progn (setq pts1 '()) (setq i 0) (setq tol (fix (vlax-curve-getEndParam ent1))) (while (<= i tol) (setq ptv (vlax-curve-getPointAtParam ent1 i)) (setq ptc (vlax-curve-getClosestPointTo ent2 ptv)) ;(entmake (list '(0 . "LINE") '(8 . "0") (cons 10 ptv) (cons 11 ptc))) (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2))) (setq pts1 (append pts1 (list mid))) (setq polylst (cons (cons mid i) polylst)) (setq i (1+ i)) ) (setq Flag (if (= (vla-get-Closed ent1) :vlax-true) 1 0)) ; Get closed status (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length pts1)) (cons 70 flag) ) (mapcar '(lambda (p) (cons 10 p)) pts1) ) ) (setq tempoly (entlast)) (setq pts2 '()) (setq i 0) (setq tol (fix (vlax-curve-getEndParam ent2))) (while (<= i tol) (setq ptv (vlax-curve-getPointAtParam ent2 i)) (setq ptc (vlax-curve-getClosestPointTo ent1 ptv)) ;(entmake (list '(0 . "LINE") '(8 . "0") (cons 10 ptv) (cons 11 ptc))) (setq mid (mapcar '/ (mapcar '+ ptv ptc) '(2 2 2))) (setq pts2 (append pts2 (list mid))) (setq i (1+ i)) ) (foreach pt pts2 (setq ptv (vlax-curve-getClosestPointTo tempoly pt)) (setq Par (vlax-curve-getParamatpoint tempoly ptv)) (setq polylst (cons (cons pt par) polylst)) ) (setq polylst (mapcar 'car (vl-sort polylst '(lambda (a b) (< (cdr a) (cdr b)))))) (entdel tempoly) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length polylst)) (cons 70 flag) ) (mapcar '(lambda (p) (cons 10 p)) polylst) ) ) (princ "\nNew midpoint polyline created.") ) (princ "\nSelection error.") ) (princ) ) -Edit Still a little janky but you can see why if you un-comment the entmake lines

Hi GLAVCVS, can you help me? When creating a grid with Lisp, is it possible to change the text style? Specifically, change it from plain text to multiple text and add a 1.2 background mask.

I've attached it again below CPL.dwg

The overall view of the drawing looks like this

https://www.cadtutor.net/forum/topic/98778-hybrid-parallel/page/2/#findComment-676816 The last code i posted works well on two open polylines. its just when they loop back on themselves that only checking the distance gets points get out of order. haven't had time to code but I think I have a solution creating a dotted pair list.

In the DWG files you posted, I can't find the polylines indicated in the images. I don't think that result was obtained with CPL. I'd like to run a test, so please attach the DWG file with the reference position in the images. Thanks

Hey @Tamim I'v made a new lisp, so you have an ESP1.lsp (for the first option 1) and an ESP2R.lsp (for the last option/option 2) for the REVCLOUD. This is the codes: ; ********************************************************************** ; Functions : ESP1 (Evenly Spacing the Polylines) --> Option 1 ; Description : Evenly Spacing Polylines --> Option 1 ; Author : SAXLLE ; Date : October 29, 2025 ; ********************************************************************** (prompt "\nTo run a LISP type: ESP1 (Evenly Spacing the Polylines 1)") (princ) (defun c:ESP1 ( / myerr olderr old_osmode flag ss len lst i spacing side base_point inc ent dist_lst npt answ) (setq old_osmode (getvar 'osmode)) (defun myerr (errmsg) (setq *error* olderr) (if (not (member errmsg '("console break" "Function Cancelled")) ) (princ (strcat "\nError: " errmsg ".\nThe application has finished working...")) ) (setvar 'osmode old_osmode) (princ) ) (setq olderr *error* *error* myerr ) (setq flag T) (while (not (equal flag nil)) (setvar 'osmode old_osmode) (prompt "\nSelect Polylines:") (princ) (setq ss (ssget (list (cons 0 "*POLYLINE"))) len (sslength ss) lst (list) i 0 ) (repeat len (setq lst (cons (list (ssname ss i) (getpropertyvalue (ssname ss i) "Length")) lst) i (1+ i) ) ) (initget 1 "Left Right") (setq lst (vl-sort lst (function (lambda (a b) (< (cadr a) (cadr b))))) side (getkword "\nChoose the side? [Left/Right]") spacing (getreal "\nEnter the spacing value:") base_point (getpoint "\nPick the Base Point for spacing:\n") inc spacing i 0 ) (setvar 'osmode 0) (command-s "_UNDO" "begin") (while (< i (length lst)) (setq ent (car (nth i lst)) dist_lst (list) dist_lst (mapcar (function (lambda (x) (distance (car x) (cadr x)))) (mapcar 'list (setq pt_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget (car (nth i lst)))))) (cdr pt_list))) ) (if (= side "Left") (progn (setq npt (list (- (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Left, using "-" sign (command-s "_pline" npt (strcat "@" (rtos (car dist_lst) 2 2) "<90") (strcat "@" (rtos (- (cadr dist_lst) inc) 2 2) "<180") (strcat "@" (rtos (caddr dist_lst) 2 2) "<270") "") ) (progn (setq npt (list (+ (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Right, using "+" sign (command-s "_pline" npt (strcat "@" (rtos (car dist_lst) 2 2) "<90") (strcat "@" (rtos (- (cadr dist_lst) inc) 2 2) "<0") (strcat "@" (rtos (caddr dist_lst) 2 2) "<270") "") ) ) (entdel (car (nth i lst))) (setq inc (+ inc spacing) i (1+ i) ) ) (command-s "_UNDO" "end") (initget 1 "Yes No Undo") (setq answ (getkword "\Do you want to continue? [Yes/No/Undo]")) (cond ((equal answ "No") (setvar 'osmode old_osmode) (setq flag nil) ) ((equal answ "Undo") (command-s "_UNDO" "") ) ) ) (prompt "\The polylines are evenly spaced!") (princ) ) ; ********************************************************************************** ; Functions : ESP2R (Evenly Spacing the Polylines 2 REVCLOUD) --> Option 2 ; Description : Evenly Spacing the Polylines 2 REVCLOUD --> Option 2 ; Author : SAXLLE ; Date : November 05, 2025 ; ********************************************************************************** (prompt "\nTo run a LISP type: ESP2R (Evenly Spacing the Polylines 2 REVCLOUD)") (princ) (defun c:ESP2R ( / old_osmode myerr olderr flag rev rev_ptlist ss lst lst_col i len sort_lst n val side spacing base_point inc ent_lst spt dist_lst ang_lst k answ) (setq old_osmode (getvar 'osmode)) (defun myerr (errmsg) (setq *error* olderr) (if (not (member errmsg '("console break" "Function Cancelled")) ) (princ (strcat "\nError: " errmsg ".\nThe application has finished working...")) ) (setvar 'osmode old_osmode) (princ) ) (setq olderr *error* *error* myerr ) (setq flag T) (while (not (equal flag nil)) (setvar 'osmode old_osmode) (setq rev (car (entsel "\nSelect the REVCLOUD:"))) (while (equal rev nil) (prompt "\nNothing was selected. Try again...") (setq rev (car (entsel "\nSelect the REVCLOUD:"))) ) (setq rev_ptlist (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget rev))) ss (ssget "_F" rev_ptlist (list (cons 0 "*POLYLINE"))) lst (list) lst_col (list) i 0 ) (if (ssmemb rev ss) (progn (ssdel rev ss) (setq len (sslength ss)) ) ) (repeat len (setq lst (cons (list (ssname ss i) (getpropertyvalue (ssname ss i) "Length") (getpropertyvalue (ssname ss i) "Color")) lst) lst_col (cons (getpropertyvalue (ssname ss i) "Color") lst_col) i (1+ i) ) ) ;; sub-function to remove the double elements from the list (defun remove_doubles (lst) (if lst (cons (car lst) (remove_doubles (vl-remove (car lst) lst))) ) ) (setq lst_col (vl-sort (remove_doubles lst_col) (function (lambda (a b) (< (atoi a) (atoi b))))) sort_lst (list) n 0 ) (repeat (length lst_col) (setq val (nth n lst_col) sort_lst (cons (vl-sort (vl-remove-if-not (function (lambda (a) (equal val (cadr (cdr a))))) lst) (function (lambda (a b) (> (cadr a) (cadr b))))) sort_lst) n (1+ n) ) ) (setq sort_lst (cons (vl-remove (car (last sort_lst)) (last sort_lst)) sort_lst) sort_lst (vl-remove (last sort_lst) sort_lst) ) (initget 1 "Left Right") (setq side (getkword "\nChoose the side? [Left/Right]") spacing (getreal "\nEnter the spacing value:") base_point (getpoint "\nPick the Base Point for spacing:\n") inc spacing i 0 ) (setvar 'osmode 0) (command-s "_UNDO" "begin") (while (< i (length sort_lst)) (setq ent_lst (nth i sort_lst) n 0 ) (repeat (length ent_lst) (setq spt (vlax-curve-getStartPoint (car (nth n ent_lst)))) (if (not (equal (car base_point) (car spt) 5.0)) (progn (command-s "_reverse" (car (nth n ent_lst)) "") ) ) (setq dist_lst (list) ang_lst (list) dist_lst (mapcar (function (lambda (x) (distance (car x) (cadr x)))) (mapcar 'list (setq pt_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget (car (nth n ent_lst)))))) (cdr pt_list))) ang_lst (mapcar (function (lambda (x) (angle (car x) (cadr x)))) (mapcar 'list (setq ang_list (mapcar 'cdr (vl-remove-if-not (function (lambda (x) (= (car x) 10))) (entget (car (nth n ent_lst)))))) (cdr ang_list))) dist_lst (subst (+ (nth 1 dist_lst) inc) (nth 1 dist_lst) dist_lst) k 0 ) (if (= side "Left") (progn (setq npt (list (- (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Left, using "-" sign (setvar 'cecolor (caddr (nth n ent_lst))) (command "_pline") (while (= (getvar "CMDNAMES") "PLINE") (command npt) (repeat (length dist_lst) (command (strcat "@" (rtos (nth k dist_lst) 2 2) "<" (angtos (nth k ang_lst)))) (setq k (1+ k)) ) (command "") ) ) (progn (setq npt (list (+ (car base_point) inc) (cadr base_point) (caddr base_point))) ;; to the Right, using "+" sign (setvar 'cecolor (caddr (nth n ent_lst))) (command "_pline") (while (= (getvar "CMDNAMES") "PLINE") (command npt) (repeat (length dist_lst) (command (strcat "@" (rtos (nth k dist_lst) 2 2) "<" (angtos (nth k ang_lst)))) (setq k (1+ k)) ) (command "") ) ) ) (entdel (car (nth n ent_lst))) (setq inc (+ inc spacing) n (1+ n) ) ) (setq i (1+ i)) ) (command-s "_UNDO" "end") (initget 1 "Yes No Undo") (setq answ (getkword "\Do you want to continue? [Yes/No/Undo]")) (cond ((equal answ "No") (setvar 'osmode old_osmode) (setq flag nil) ) ((equal answ "Undo") (command-s "_UNDO" "") ) ) ) (setvar 'cecolor "256") ;; restore the color "ByLayer" (prompt "\The polylines are evenly spaced using Evenly Spacing the Polylines 2 - REVCLOUD!") (princ) ) This is the short video example how the ESP2R.lsp works. EvenlySpacingPolyline_V2.mp4 Best regards.

I already attached it in one of my two previous posts