All Activity

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

Could you post the dwg?

Here is my first attempt at this problem. It creates offset lines and checks the intersections. The precision is dictated by the offsetdistance. The lower it is, the longer it takes to make the polyline and the more points it will have. But it will be more accurate. Afterwards I run this function on the resulting polyline to clean it up. ;| ; Center line - dexus ; https://www.cadtutor.net/forum/topic/98778-hybrid-parallel |; (defun c:testcl (/ ent1 lst offset offsetdistance pts r s1 s2 ss start te1 te2) (defun _polyline (pts) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length pts)) (cons 8 (getvar 'clayer)) (cons 70 0) ) (mapcar (function (lambda (x) (cons 10 x))) pts) ) ) ) (defun _side (pline pnt / cpt end target der) ; https://www.theswamp.org/index.php?topic=55685.msg610429#msg610429 (setq cpt (vlax-curve-getClosestPointTo pline pnt) end (vlax-curve-getEndParam pline) target (vlax-curve-getParamAtPoint pline cpt) der (if (and (equal target (fix target) 1e-8) (or (vlax-curve-isClosed pline) (and (not (equal (vlax-curve-getStartParam pline) target 1e-8)) (not (equal end target 1e-8))) ) ) (mapcar '- (polar cpt (angle '(0 0) (vlax-curve-getFirstDeriv pline (rem (+ target 1e-3) end))) 1.0) (polar cpt (angle (vlax-curve-getFirstDeriv pline (rem (+ (- target 1e-3) end) end)) '(0 0)) 1.0) ) (vlax-curve-getFirstDeriv pline target) ) ) (minusp (sin (- (angle cpt pnt) (angle '(0.0 0.0) der)))) ) ;; Intersections - Lee Mac ;; mod - [int] acextendoption enum of intersectwith method (defun LM:intersections ( ob1 ob2 mod / lst rtn ) (if (and (vlax-method-applicable-p ob1 'intersectwith) (vlax-method-applicable-p ob2 'intersectwith) (setq lst (vlax-invoke ob1 'intersectwith ob2 mod)) ) (repeat (/ (length lst) 3) (setq rtn (cons (list (car lst) (cadr lst) (caddr lst)) rtn) lst (cdddr lst)) ) ) (reverse rtn) ) (defun getLength (ent) (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)) ) (if (not (while (cond ((not (setq ss (ssget '((0 . "LWPOLYLINE"))))) (princ "\nNothing selected. Try again...\n") ) ((/= (sslength ss) 2) (princ "\nSelect 2 polylines! Try again...\n") ) ((and (setq ent1 (ssname ss 0)) (setq ent2 (ssname ss 1)) (setq ent1 (vlax-ename->vla-object ent1)) (setq ent2 (vlax-ename->vla-object ent2)) ) nil ; Stop loop ) ) ) ) (progn (setq s1 (_side ent1 (vlax-curve-getStartPoint ent2))) (setq s2 (_side ent2 (vlax-curve-getStartPoint ent1))) (setq maxlen (max (getLength ent1) (getLength ent2))) (setq offset 0.0) (setq offsetdistance (/ maxlen 1024.0)) (while (progn (setq offset (+ offset offsetdistance)) (setq te1 nil) (setq te2 nil) (setq r (cond ( (or ; Make offset (vl-catch-all-error-p (setq te1 (vl-catch-all-apply 'vlax-invoke (list ent1 'Offset (if s1 offset (- offset)))))) (vl-catch-all-error-p (setq te2 (vl-catch-all-apply 'vlax-invoke (list ent2 'Offset (if s2 offset (- offset)))))) ) (princ "\nOffset failed. ") nil ) ((setq lst (LM:intersections (car te1) (car te2) acExtendNone)) (setq len (getLength (car te1))) (setq lst (mapcar (function (lambda (pt) (list (/ (vlax-curve-getDistAtPoint (car te1) pt) len) pt))) lst)) (setq start t) (setq pts (append lst pts)) ) ((> offset maxlen) nil) ((not start) t) (start nil) ) ) (if te1 (mapcar 'vla-delete te1)) (if te2 (mapcar 'vla-delete te2)) r ) ) (if pts (_polyline (mapcar 'cadr (vl-sort pts (function (lambda (a b) (< (car a) (car b))))))) ) ) ) )

8 years later....

I already stated that in a few posts. All of them fail in certain situations. That's why people are still taking a shot at solving the issue. I have also already mentioned Civil/GIS programs can do this pretty well. QGIS (free/donation) has a plug-in to do this.

the bom is stored in the “bom dic ”

Welcome back to big game hunting!

I was wrong. c:CPL of @GP_ is also inconsistent in some cases. CPL.dwg

@Saxlle Based on this code, everything is working fine. But I need only a specific selection — the sample yellow rectangle area I mentioned earlier. Also, I need to add my idea for selecting the REVCLOUD area after the code runs. line shifting v2.dwg

@BIGAL Thanks for the code

Could you post a sample drawing of what you would use this on and what your looking for. Rather then picking points for the grid you could do a selection and run the bounding box (defun C:foo () (if (setq SS (ssget)) (BBOX) (command "_.RECTANG" LL UR) (prompt (strcat "El rectángulo mide: " (car L&W) " x " (cadr L&W))) ) (princ) ) ;;----------------------------------------------------------------------------;; ;; Length and Width of a Selection (defun BBox (/ ptslst) (foreach ent (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) (vla-getboundingbox (vlax-ename->vla-object ent) 'minpt 'maxpt) (setq ptslst (cons (vlax-safearray->list minpt) ptslst) ptslst (cons (vlax-safearray->list maxpt) ptslst) ) ) (setq LL (apply 'mapcar (cons 'min ptslst)) UR (apply 'mapcar (cons 'max ptslst)) L&W (mapcar '- UR LL) ) (princ) )

Dear friend GLAVCVS, thank you so much for your reply. The routine worked perfectly. I'm very grateful for your help. Regards

Hi Omar. Bienvenido Try this (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))))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; 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 ) (command "TEXT" "R" (list (- x2 dl) (+ startY dh)) alto 0 coordY ) ) ) (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 ) (command "TEXT" "R" (list (- startX dh) (- y2 dl)) alto 100 coordX ) ) ) (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") ) The "command" calls in your code are designed for an English version of AutoCAD, and mine is in Spanish. For this reason, and due to lack of time, I haven't tested the code sufficiently. Try it yourself and then comment on the results.