(defun c:creasez () (setq pol(entsel "\n....... seleziona la polilinea : ")) (if (/= pol nil)(progn (setq NomeFile(getstring "\n....... Nome File TXT: ")) (setq Separatore(getstring "\n....... Carattere separatore di NUM X Y: ")) (if (= Separatore "")(setq Separatore " ")) (setq NumSez(getstring "\n....... Numero sezione: ")) (setq ProgSez(getstring "\n....... Progressiva sezione: ")) (setq FF(open (strcat NomeFile ".txt") "a")) (write-line NumSez FF) (write-line ProgSez FF) (if (= (cdr(assoc 0 (entget (car pol)))) "LWPOLYLINE")(progn (setq li-crea nil) (setq w(getpoint "\n....... punto sulla linea di riferimento : ")) (setq quota(getreal " => a quota : ")) (setq scalay(getreal "\n....... rapporto scala distanze / scala quote : ")) (setq qrif(cadr w)) (setq conta 0) (setq i 0) (setq lwp(entget(car pol))) (repeat (length lwp) (setq lwele(nth i lwp)) (if (= (car lwele) 10)(progn (setq x(cadr lwele)) (setq y(caddr lwele)) (setq y(+ (/ (- y qrif) scalay) quota)) (setq conta(+ conta 1)) (setq xconta(itoa conta)) (if (= conta 1) (setq Xprog x)) (setq x(- x Xprog)) (write-line (strcat xconta Separatore (rtos x 2 2) Separatore (rtos y 2 2)) FF) ) ) (setq i (+ i 1)) ) (close FF) ) ;;;;;;<<>> (if (and (= (cdr(assoc 0 (entget (car pol)))) "POLYLINE")(/= pol nil))(progn (setq li-crea nil) (setq w(getpoint "\n....... punto sulla linea di riferimento : ")) (setq quota(getreal " => a quota : ")) (setq scalay(getreal "\n....... rapporto scala distanze / scala quote : ")) (setq qrif(cadr w)) (setq pol-princ(entget (car pol))) (setq vertice(entnext (car pol))) (setq vert(entget vertice)) (setq conta 0) (while (/= (cdr (assoc 0 vert)) "SEQEND") (setq x(car(cdr(assoc 10 vert)))) (setq y(cadr(cdr(assoc 10 vert)))) (setq y(+ (/ (- y qrif) scalay) quota)) (setq conta(+ conta 1)) (setq xconta(itoa conta)) (if (= conta 1) (setq Xprog x)) (setq x(- x Xprog)) (write-line (strcat xconta Separatore (rtos x 2 2) Separatore (rtos y 2 2)) FF) (setq vertice(entnext vertice)) (setq vert(entget vertice)) ) (close FF) ) ;;;;;;<<>> (progn (princ " Deve essere una POLYLINE o una LWPOLYLINE! < premi un tasto per proseguire >") (getstring) (princ "\r ") ) ) )) )) ;--------------------------------------------------------------------- (princ "\n Digitare CREASEZ per lanciare il programma!") (princ)