Leaderboard

Give this a try .. you should use the built in *error* handler: ;; OK_Y___________________________________ (defun c:vy (/ *error* opry pwy p1y v1y m1y t1y vars vals) ;; Error handler (defun *error* (msg) (mapcar 'setvar vars vals) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (princ) ) ;; Save values and variables (setq vals (mapcar 'getvar (setq vars '(clayer orthomode luprec textsize tspacefac orthomode)))) (s_var) (n_lay) (initget "TN R G B NC MC OTRO") (setq opry (getkword "\nPREFIJO EN Y [TN/R/G/B/NC/MC/OTRO] <R>: ")) (q_estion) (if (= opry "TN") (ytn) ) ;end if (if (= opry "G") (yg) ) ;end if (if (= opry "B") (yb) ) ;end if (if (= opry "NC") (ync) ) ;end if (if (= opry "MC") (ymc) ) ;end if (if (= opry "OTRO") (yotro) ) ;end if (while (setq wpy (getpoint "\nQUE PUNTO: ")) (setq p1y (cadr wpy)) ;coordinada en y (setq v1y (rtos p1y 2 2)) (setq m1y (strcat "R= " v1y)) (setq t1y (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1y "j" "ml" "r" "90" "w" "0" m1y "") (command "_.move" "l" "" t1y (cons (- (car t1y) -0.17) (cdr t1y))) ) ;while ;; Reset variables (mapcar 'setvar vars vals) (princ) ) ;end ;; OK_XY___________________________________________________ (defun c:vxy (/ *error* oprx wpx p1x p2x v1x v2x m1x m2x t1x t2x vars vals) ;; Error handler (defun *error* (msg) (mapcar 'setvar vars vals) (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")) (princ (strcat "\nError: " msg)) ) (princ) ) ;; Save values and variables (setq vals (mapcar 'getvar (setq vars '(clayer orthomode luprec textsize tspacefac orthomode)))) (s_var) (n_lay) (initget "TN NU R G B NC MC OTRO") (setq oprx (getkword "\nOFFEST + PREFIJO EN Y [TN/NU/R/G/B/NC/MC/OTRO] <R=>: ")) (q_estion) (if (= oprx "TN") (xtn) ) ;end if (if (= oprx "R") (xr) ) ;end if (if (= oprx "G") (xg) ) ;end if (if (= oprx "B") (xb) ) ;end if (if (= oprx "NC") (xnc) ) ;end if (if (= oprx "MC") (xmc) ) ;end if (if (= oprx "NU") (xnu) ) ;end if (if (= oprx "OTRO") (xotro) ) ;end if (while (setq wpx (getpoint "\nQUE PUNTO: ")) (setq p1x (car wpx)) ;coordinada en x (setq p2x (cadr wpx)) ;coordinada en y (setq v1x (rtos p1x 2 2)) (setq v2x (rtos p2x 2 2)) (setq m1x (strcat "OFF= " v1x)) (setq m2x (strcat "R= " v2x)) (setq t1x (getpoint "\nDONDE TEXTO: ")) (command "mtext" t1x "j" "ml" "r" "90" "w" "0" m1x m2x "") ) ;while ;; Reset variables (mapcar 'setvar vars vals) (princ) ) Also .. not getting too far in the weeds but ... ;; This (if (= opry "TN") (ytn) ) ;end if (if (= opry "G") (yg) ) ;end if (if (= opry "B") (yb) ) ;end if (if (= opry "NC") (ync) ) ;end if (if (= opry "MC") (ymc) ) ;end if (if (= opry "OTRO") (yotro) ) ;end if ;; Could be this (cond ((= opry "TN") (ytn)) ((= opry "G") (yg)) ((= opry "B") (yb)) ((= opry "NC") (ync)) ((= opry "MC") (ymc)) ((= opry "OTRO") (yotro)) )

Here's a simple vlisp program that places a point at the start of lines you select. (defun c:lstart(/) (command "_pdmode" "35" "") (setq osnp (getvar "osmode")) (setvar "osmode" 0) if (setq ss (ssget '((0 . "LINE")))) (progn (setq i 0) (while (setq en (ssname ss i)) (setq ed (entget en)) (setq pos (cdr (assoc 10 ed))) (command "point" pos "" ) (setq i (1+ i) ) ; end setq i ) ;end while ) ; end progn ) ;end if (setvar "osmode" osnp) (princ) )

Try this. Modified lisp slightly (defun rh:get_elev ( msg / ss rtn) (prompt msg) (setq ss (ssget "_+.:E:S" '((0 . "TEXT")))) (cond ( (not ss) (initget 3) (setq rtn (getreal "\nEnter Level : ")) ) (t (setq rtn (atof (cdr (assoc 1 (entget (ssname ss 0)))))) ) );end_cond );end_defun ;interpolation function to populate text elevation labels ; written by Nete Laana on 24.01.18 Modified dlanorh 30.04.19 (defun c:INTEL (/ p1 p2 p3 e1 e2 e3 d1 d2) ;define the function intel (while (setq p1 (getpoint "\nPick First Point : "));get the first point (setq e1 (rh:get_elev "\nSpecify First Elevation : ");get first elevation p2 (getpoint "\nPick Second Point : ");get the second point e2 (rh:get_elev "\nSpecify Second Elevation : ");get second elevation d1 (distance p1 p2); calculate total distance );end_setq (command "Line" p1 p2 "");draw the line (setq p3 (getpoint "\nPick Interpolation Point : "); pick desired interpolation point d2 (distance p1 p3); calculate distance a e3 (+ (/ (* (- e2 e1) d2) d1) e1);calculate interpolated elevation );end_setq (entdel (entlast)); delete the line (command "circle" p3 0.15); draw circle to identify point (command ".TEXT" p3 1.2 0 (rtos e3 2 2)); dump e3 as text object (setq p1 nil) );end_while (princ) );end_defun The lisp will now loop and ask for the next "Pick First Point : ". To exit the loop press return or click the right mouse button if it is set up that way.

@Emmanuel Delay Thanks bro. It is working amazingly

You can also do this, then you select the text objects instead of this: (setq layers (getstring "\nLayers to extract, example Layer1,Layer2 : ")) (setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 layers) ))) do this (setq ss (ssget (list (cons 0 "TEXT") )))

Okay, you can type the layer, or layers now. comma separated, for example Layer1 or Layer1,Layer2 ;; @FILE export texts. contents, insert point, layer (vl-load-com) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Exporting to csv ;; http://www.lee-mac.com/writecsv.html ;; Write CSV - Lee Mac ;; Writes a matrix list of cell values to a CSV file. ;; lst - [lst] list of lists, sublist is row of cell values ;; csv - [str] filename of CSV file to write ;; Returns T if successful, else nil (defun LM:WriteCSV ( lst csv / des sep ) (if (setq des (open csv "w")) (progn (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (","))) (foreach row lst (write-line (LM:lst->csv row sep) des)) (close des) t ) ) ) ;; List -> CSV - Lee Mac ;; Concatenates a row of cell values to be written to a CSV file. ;; lst - [lst] list containing row of CSV cell values ;; sep - [str] CSV separator token (defun LM:lst->csv ( lst sep ) (if (cdr lst) (strcat (LM:csv-addquotes (car lst) sep) sep (LM:lst->csv (cdr lst) sep)) (LM:csv-addquotes (car lst) sep) ) ) (defun LM:csv-addquotes ( str sep / pos ) (cond ( (wcmatch str (strcat "*[`" sep "\"]*")) (setq pos 0) (while (setq pos (vl-string-position 34 str pos)) (setq str (vl-string-subst "\"\"" "\"" str pos) pos (+ pos 2) ) ) (strcat "\"" str "\"") ) ( str ) ) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Command ET, for Extract Text (defun c:ET ( / ss i rows ent filepath layers) ;; Select the text objects (setq layers (getstring "\nLayers to extract, example Layer1,Layer2 : ")) (setq ss (ssget "X" (list (cons 0 "TEXT") (cons 8 layers) ))) ;;;; Or maybe you also want MTEXT, then you replace "TEXT" with "TEXT,MTEXT" ;;;; notice: Mtext encodes "new line" as "\P", and may also contain code for style (like color, bold...) ;; the head (column titles) of the CSV. You coule leave this blank, like this: (setq rows (list)) (setq rows (list (list "LAYER" "X" "Y" "ROTATION" "TEXT"))) ;; read the data, put it in a list (in variable rows) (setq i 0) (repeat (sslength ss) (setq ent (entget (ssname ss i))) ;; extract the properties ;; add the data to rows (setq rows (append rows (list (list (cdr (assoc 8 ent)) ;; Layer (rtos (nth 0 (cdr (assoc 10 ent))) 2 16) ;; X value, notice: numbers must be converted to text, that's what the rtos does. Feel free to change the precision (the 16) (rtos (nth 1 (cdr (assoc 10 ent))) 2 16) ;; Y value (rtos (/ (* (cdr (assoc 50 ent)) 180) pi ) 2 16) ;; rotation - ("angle in rad" * 180 / pi) = angle in 360 degrees (cdr (assoc 1 ent)) ;; Text contents )))) (setq i (+ i 1)) ) ;; we'll save the file in the same path, and same file name as the dwg, except with extension .csv ;; (make sure the drawing is saved somewhere, and make sure that location is writable) (setq filepath (strcat (getvar "dwgprefix") (vl-filename-base (getvar "dwgname")) ".csv")) ;; save to csv (if (LM:WriteCSV rows filepath) (progn (princ "\nSaved as: ") (princ filepath)) (progn (princ "\nSomething went wrong")) ) (princ) )