Leaderboard

Try this .. you need to get the viewport ID ( DXF code 69 ). (defun c:test (/ *error* entvp escvp inv-vps old_err strscale) ;inicio de la rutina ;;(setq old_err *error*) ;;(defun *error* (a /) (princ "") (setq *error* old_err) (princ)) ;;(setvar "cmdecho" 0) (if (and (setq entvp (car (entsel "\Seleccione VIEWPORT: "))) (= (cdr (assoc 0 (entget entvp))) "VIEWPORT") ) (progn (setq escvp (vla-get-customscale (vlax-ename->vla-object entvp))) (setq strscale (rtos (/ 1 escvp) 2 2)) (prompt (strcat "\nLa escala de La Ventana es 1/" strscale)) ;; You need to set the viewport ID after going into floating modelspace (command "_.MSPACE") (setvar 'cvport (cdr (assoc 69 (entget entvp)))) ) ) (setq inv-vps (/ 1 escvp)) ;;(setvar "cmdecho" 1) (terpri) (princ escvp) (terpri) (princ strscale) (terpri) (princ) ) BTW .. the code you posted above is missing parenthesis so not sure how you're using it?

Try this. (defun c:test (/ ss escvp strscale) (setvar 'cvport 1) ;goes into PAPERSPACE automatically (if (setq ss (ssget "_+.:E:S" '((0 . "VIEWPORT")))) ;only allows you to pick a viewport (progn (setq escvp (vla-get-customscale (setq vp (vlax-ename->vla-object (ssname SS 0)))) strscale (rtos (/ 1 escvp) 2 2) ) ;; You need to set the viewport ID after going into floating modelspace (setvar 'cvport (cdr (assoc 69 (entget (ssname SS 0))))) (prompt (strcat "\nLa escala de La Ventana es 1/" strscale " = " (rtos escvp 2))) ) ) (princ) )

You want to draw lines with those coordinates, right? -To make it easy, save the Excel file as csv (3 line sample in attachment here) - top of the script, make sure the settings of the file match (this can be handled with open file dialog if needed) - I just take the coordinates and ignore all other columns. type command IMC (for Import Lines Csv) I call it import, from the point of view of Autocad. (vl-load-com) ;; SETTINGS ;; you need to set this to the path and filename on your computer (setq csv_file "C:\\Data\\desktop\\lisp\\CADTUTOR\\import_lines_csv.csv") ;; delimitor. Check how Excel saves the file to CSV. Either comma or somicolon (setq csvdelimiter ",") ;;(setq csvdelimiter ";") ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; http://www.lee-mac.com/readcsv.html ;; Read CSV - Lee Mac ;; Parses a CSV file into a matrix list of cell values. ;; csv - [str] filename of CSV file to read (defun LM:readcsv ( csv / des lst sep str ) (if (setq des (open csv "r")) (progn (setq sep (cond ((vl-registry-read "HKEY_CURRENT_USER\\Control Panel\\International" "sList")) (csvdelimiter))) (while (setq str (read-line des)) (setq lst (cons (LM:csv->lst str sep 0) lst)) ) (close des) ) ) (reverse lst) ) ;; CSV -> List - Lee Mac ;; Parses a line from a CSV file into a list of cell values. ;; str - [str] string read from CSV file ;; sep - [str] CSV separator token ;; pos - [int] initial position index (always zero) (defun LM:csv->lst ( str sep pos / s ) (cond ( (not (setq pos (vl-string-search sep str pos))) (if (wcmatch str "\"*\"") (list (LM:csv-replacequotes (substr str 2 (- (strlen str) 2)))) (list str) ) ) ( (or (wcmatch (setq s (substr str 1 pos)) "\"*[~\"]") (and (wcmatch s "~*[~\"]*") (= 1 (logand 1 pos))) ) (LM:csv->lst str sep (+ pos 2)) ) ( (wcmatch s "\"*\"") (cons (LM:csv-replacequotes (substr str 2 (- pos 2))) (LM:csv->lst (substr str (+ pos 2)) sep 0) ) ) ( (cons s (LM:csv->lst (substr str (+ pos 2)) sep 0))) ) ) (defun LM:csv-replacequotes ( str / pos ) (setq pos 0) (while (setq pos (vl-string-search "\"\"" str pos)) (setq str (vl-string-subst "\"" "\"\"" str pos) pos (1+ pos) ) ) str ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun drawLine (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))) ) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; IMC for Import Lines Csv (defun c:IMC ( / csv_data i a) (setq csv_data (LM:readcsv csv_file)) (setq i 0) (foreach a csv_data ;; a is 1 line of the csv data (if (> i 0) (progn ;; Skip the first line that holds the title of the columns (drawLine (list (atof (nth 0 a)) (atof (nth 1 a)) (atof (nth 4 a)) ) (list (atof (nth 2 a)) (atof (nth 3 a)) (atof (nth 5 a)) ) ) )) (setq i (+ i 1)) ) (princ) ) import_lines_csv.csv

Try this using my suggestion above - intersections from Lee Mac will work better I reckon though (defun XYZchange ( XYZ x y z / nx ny nz ) (setq nX (+ x (car XYZ)) nY (+ y (cadr XYZ)) nZ (+ z (caddr XYZ)) );end setq (list nx ny nz) ) (defun C:fund ( / ent sel dik BRR BR1 startpt endpt MyPline tleft tright Bleft Bright ) ;------------------------------------------------------------; (setq ent (entsel)) (setq sel (ssadd (car ent))) (setq dik (* -1 (getreal "Thickness: "))) (setq BRR (getreal "Extra offset: ")) (c:dex sel BRR) ;; extend line (setq BRl (* -1 BRR)) (setq MyPline (vlax-ename->vla-object (car ent)) startpt (vlax-curve-getStartPoint MyPline) endpt (vlax-curve-getEndPoint MyPline) );end setq ;;------------------------------------------------------------; (if (< (car startpt) (car endpt)) (progn (setq tleft startpt) (setq tright endpt) );end progn (progn (setq tleft endpt) (setq tright startpt) );end progn );end if ;;------------------------------------------------------------; (setq Bleft (XYZchange tleft 0 dik 0)) (setq Bright (XYZchange tright 0 dik 0)) (command "copy" ent "" tleft bleft) (setq entb (entlast)) ;;------------------------------------------------------------; (command "line" (cdr (assoc 10 (entget entb))) (cdr (assoc 10 (entget (car ent)))) "") ;; end line A (command "line" (cdr (assoc 11 (entget entb))) (cdr (assoc 11 (entget (car ent)))) "") ;; end line B ;;------------------------------------------------------------; ; (setq ; toleft (XYZchange tleft brl 0 0) ; toright (XYZchange tright brr 0 0) ; boleft (XYZchange bleft brl 0 0) ; boright (XYZchange bright brr 0 0) ; );end setq ; (command "line" toleft boleft "") ; (setq entl (entlast)) ; (command "line" toright boright "") ; (setq entr (entlast)) ;;------------------------------------------------------------; ; (command "chamfer" "d" 0 0 tleft bleft) ; (command "chamfer" "d" 0 0 tright bright) ; (command "chamfer" "d" 0 0 bleft entl) ; (command "chamfer" "d" 0 0 bright entr) ) ;;http://lee-mac.com/doubleextend.html (defun c:dex ( sel ext1 / *error* an1 an2 dis ent enx idx lst pt1 pt2 rad tmp typ ) ;;(defun c:dex ( / *error* an1 an2 dis ent enx idx lst pt1 pt2 rad tmp typ ) ;; original line (defun *error* ( msg ) (LM:endundo (LM:acdoc)) (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")) (princ (strcat "\nError: " msg)) ) (princ) ) (LM:startundo (LM:acdoc)) (if (and (setq tmp (getenv "LMac\\dex")) (setq tmp (distof tmp)) (< 0 tmp) ) (setq ext tmp) ) (initget 6) (if (and ; (setq ext ; (cond ; ( (getdist ; (strcat "\nSpecify extension" ; (if ext (strcat " <" (rtos ext) "> : ") ": ") ; ) ; ) ; ) ; ( ext ) ; ) ; ) ; end setq (setq ext ext1) ;; added this line ; (setq sel ; (LM:ssget "\nSelect lines, arcs and/or polylines to extend: " ; '( "_:L" ; ( ; (-4 . "<OR") ; (0 . "LINE,ARC") ; (-4 . "<AND") ; (0 . "LWPOLYLINE") ; (-4 . "<NOT") ; (-4 . "&=") (70 . 1) ; (-4 . "NOT>") ; (-4 . "AND>") ; (-4 . "<AND") ; (0 . "POLYLINE") ; (-4 . "<NOT") ; (-4 . "&=") (70 . 87) ; (-4 . "NOT>") ; (-4 . "AND>") ; (-4 . "OR>") ; ) ; ) ; ) ; ) ; end setq ) ; end and (progn (setenv "LMac\\dex" (rtos ext)) (repeat (setq idx (sslength sel)) (setq ent (ssname sel (setq idx (1- idx))) enx (entget ent) typ (cdr (assoc 0 enx)) ) (cond ( (= "LINE" typ) (setq pt1 (cdr (assoc 10 enx)) pt2 (cdr (assoc 11 enx)) dis (distance pt1 pt2) ) (if (not (equal 0.0 dis 1e-8)) (progn (setq dis (/ (+ dis ext) dis)) (entmod (subst (cons 10 (mapcar '+ pt2 (vxs (mapcar '- pt1 pt2) dis))) (assoc 10 enx) (subst (cons 11 (mapcar '+ pt1 (vxs (mapcar '- pt2 pt1) dis))) (assoc 11 enx) enx ) ) ) ) ) ) ( (= "ARC" typ) (setq rad (cdr (assoc 40 enx)) an1 (cdr (assoc 50 enx)) an2 (cdr (assoc 51 enx)) ) (if (< (+ (* rad (rem (+ (- an2 an1) pi pi) (+ pi pi))) ext ext) (* 2.0 rad pi)) (entmod (subst (cons 50 (- an1 (/ ext rad))) (assoc 50 enx) (subst (cons 51 (+ an2 (/ ext rad))) (assoc 51 enx) enx ) ) ) ) ) ( (= "LWPOLYLINE" typ) (entmod (append (reverse (member (assoc 39 enx) (reverse enx))) (apply 'append (LM:dex:extendpoly (LM:lwvertices enx) ext)) (list (assoc 210 enx)) ) ) ) ( (= "POLYLINE" typ) (while (/= "SEQEND" (cdr (assoc 0 enx))) (setq ent (entnext ent) enx (entget ent) lst (cons enx lst) ) ) (foreach vtx (LM:dex:extendpoly (reverse (cdr lst)) ext) (entmod vtx)) (entupd (cdr (assoc -2 enx))) ) ) ) ) ) (LM:endundo (LM:acdoc)) (princ) ) (defun LM:dex:extendpoly ( lst ext / ang bul cen dis len pt1 pt2 pt3 rad ) (setq pt1 (cdr (assoc 10 (car lst))) pt2 (cdr (assoc 10 (cadr lst))) bul (cdr (assoc 42 (car lst))) dis (distance pt1 pt2) ) (if (equal 0.0 bul 1e-8) (if (not (equal 0.0 dis 1e-8)) (setq dis (/ (+ dis ext) dis) lst (cons (subst (cons 10 (mapcar '+ pt2 (vxs (mapcar '- pt1 pt2) dis))) (assoc 10 (car lst)) (car lst) ) (cdr lst) ) ) ) (progn (setq cen (LM:bulgecentre pt1 pt2 bul) rad (/ (* dis (1+ (* bul bul))) 4 (abs bul)) len (abs (* 4 (atan bul) rad)) ) (if (< (+ len ext) (* rad 2 pi)) (setq pt3 (polar cen ((if (minusp bul) + -) (angle cen pt1) (/ ext rad)) rad) ang ((if (minusp bul) - +) (atan bul) (/ ext rad 4.0)) lst (cons (subst (cons 10 pt3) (assoc 10 (car lst)) (subst (cons 42 (/ (sin ang) (cos ang))) (assoc 42 (car lst)) (car lst) ) ) (cdr lst) ) ) ) ) ) (setq lst (reverse lst) pt1 (cdr (assoc 10 (car lst))) pt2 (cdr (assoc 10 (cadr lst))) bul (cdr (assoc 42 (cadr lst))) dis (distance pt1 pt2) ) (if (equal 0.0 bul 1e-8) (if (not (equal 0.0 dis 1e-8)) (setq dis (/ (+ dis ext) dis) lst (cons (subst (cons 10 (mapcar '+ pt2 (vxs (mapcar '- pt1 pt2) dis))) (assoc 10 (car lst)) (car lst) ) (cdr lst) ) ) ) (progn (setq cen (LM:bulgecentre pt2 pt1 bul) rad (/ (* dis (1+ (* bul bul))) 4 (abs bul)) len (abs (* 4 (atan bul) rad)) ) (if (< (+ len ext) (* rad 2 pi)) (setq pt3 (polar cen ((if (minusp bul) - +) (angle cen pt1) (/ ext rad)) rad) ang ((if (minusp bul) - +) (atan bul) (/ ext rad 4.0)) lst (vl-list* (subst (cons 10 pt3) (assoc 10 (car lst)) (car lst) ) (subst (cons 42 (/ (sin ang) (cos ang))) (assoc 42 (cadr lst)) (cadr lst) ) (cddr lst) ) ) ) ) ) (reverse lst) ) ;; Vector x Scalar - Lee Mac ;; Args: v - vector in R^n, s - real scalar (defun vxs ( v s ) (mapcar '(lambda ( n ) (* n s)) v) ) ;; Bulge Centre - Lee Mac ;; p1 - start vertex ;; p2 - end vertex ;; b - bulge ;; Returns the centre of the arc described by the given bulge and vertices (defun LM:bulgecentre ( p1 p2 b ) (polar p1 (+ (angle p1 p2) (- (/ pi 2) (* 2 (atan b)))) (/ (* (distance p1 p2) (1+ (* b b))) 4 b) ) ) ;; LW Vertices - Lee Mac ;; Returns a list of lists in which each sublist describes ;; the position, starting width, ending width and bulge of the ;; vertex of a supplied LWPolyline (defun LM:lwvertices ( e ) (if (setq e (member (assoc 10 e) e)) (cons (list (assoc 10 e) (assoc 40 e) (assoc 41 e) (assoc 42 e) ) (LM:lwvertices (cdr e)) ) ) ) ;; ssget - Lee Mac ;; A wrapper for the ssget function to permit the use of a custom selection prompt ;; msg - [str] selection prompt ;; arg - [lst] list of ssget arguments (defun LM:ssget ( msg arg / sel ) (princ msg) (setvar 'nomutt 1) (setq sel (vl-catch-all-apply 'ssget arg)) (setvar 'nomutt 0) (if (not (vl-catch-all-error-p sel)) sel) ) ;; Start Undo - Lee Mac ;; Opens an Undo Group. (defun LM:startundo ( doc ) (LM:endundo doc) (vla-startundomark doc) ) ;; End Undo - Lee Mac ;; Closes an Undo Group. (defun LM:endundo ( doc ) (while (= 8 (logand 8 (getvar 'undoctl))) (vla-endundomark doc) ) ) ;; Active Document - Lee Mac ;; Returns the VLA Active Document Object (defun LM:acdoc nil (eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object)))) (LM:acdoc) ) (vl-load-com) (princ (strcat "\n:: DoubleExtend.lsp | Version 1.0 | \\U+00A9 Lee Mac " (menucmd "m=$(edtime,0,yyyy)") " www.lee-mac.com ::" "\n:: Type \"dex\" to Invoke ::" ) )