(defun c:zeta (/ var en1 quota selez n_ent lista tipo p1 x1 y1 p2 x2 y2)
;*************************************
(setq var (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq old-error *error*)
(defun *error* (msg)
(alert msg)
(setq *error* old-error)
(command "_undo" "_end" "_u")
(exit)
)
(command "_undo" "_be")
;*************************************
;inizio procedura
(initget (+ 1 0))
(setq quota (getreal "\n Immettere la quota: "))
(princ "\nSelezionare le linee che si intendono portare alla stessa quota: ")
;(setq quota (atoi quota));cambia la stringa immessa in un numero
(setq selez (ssget '((-4 . "
(if (not selez)
(alert "Non è stato selezionato nulla oppure \nla selezione non ha passato il filtro")
(progn
(setq n 0)
(setq ent1 (ssname selez n)) ;nome della prima entità della selezione
(setq n_ent (sslength selez)) ;numeri di oggetti contenuti nel gruppo di selezione selez
(setq lista (entget ent1)) ;-------LISTA DELL'oggetto
(setq tipo (cdr (assoc 0 lista)))
(while (/= ent1 nil) ;while uno
(progn
(if (/= tipo "LWPOLYLINE")
(if (/= tipo "POLYLINE")
(if (/= tipo "SEQEND")
(if (/= tipo "LINE")
(coordp1_emi)
)
)
)
)
(if (= tipo "LINE")
(coordp2_emi))
(if (= tipo "LWPOLYLINE")
(progn
(setq P1 quota)
(setq lista (subst (cons 38 p1) (assoc 38 lista) lista))
(entmod lista)
(pass_emi)
)
)
(if (= tipo "POLYLINE")
(progn
(setq ent1 (entnext ent1))
(setq lista (entget ent1))
(setq tipo (cdr (assoc 0 lista)))
(while (= tipo "VERTEX")
(progn
(setq x1 (nth 1 (assoc 10 lista)))
(setq y1 (nth 2 (assoc 10 lista)))
(setq P1 (list x1 y1 quota))
(setq lista (subst (cons 10 p1) (assoc 10 lista) lista))
(entmod lista)
(setq ent1 (entnext ent1))
(if (/= ent1 nil)
(progn
(setq lista (entget ent1)) ;-------LISTA DELL'oggetto
(setq tipo (cdr (assoc 0 lista))) ;-----tipo oggetto
)
)
)
);chiudi while
(pass_emi)
)
)
(sequenza)
);chiudi progn while uno
(if (= tipo "SEQEND")
(pass_emi)
)
);chiudi while uno
);chiudi progn if
);chiudi if
;fine procedura
(setq *error* old-error)
(command "_undo" "_end")
(setvar "cmdecho" var)
(setvar "modemacro" "")
)
;FUNZIONE DI UTILITA' PER C:ZETA
(defun coordp1_emi ()
(setq x1 (nth 1 (assoc 10 lista)))
(setq y1 (nth 2 (assoc 10 lista)))
(setq P1 (list x1 y1 quota))
(setq lista (subst (cons 10 p1) (assoc 10 lista) lista))
(entmod lista)
(pass_emi)
)
;FUNZIONE DI UTILITA' PER C:ZETA
(defun coordp2_emi ()
(setq x2 (nth 1 (assoc 11 lista)))
(setq y2 (nth 2 (assoc 11 lista)))
(setq P2 (list x2 y2 quota))
(setq lista (subst (cons 11 p2) (assoc 11 lista) lista))
(entmod lista)
(setq x1 (nth 1 (assoc 10 lista)))
(setq y1 (nth 2 (assoc 10 lista)))
(setq P1 (list x1 y1 quota))
(setq lista (subst (cons 10 p1) (assoc 10 lista) lista))
(entmod lista)
(pass_emi)
)
;FUNZIONE DI UTILITA' PER C:ZETA
(defun pass_emi ()
(setq n (+ n 1))
(setq ent1 (ssname selez n)) ;nome dell'oggetto successivo
(if (/= ent1 nil)
(progn
(setq lista (entget ent1)) ;-------LISTA DELL'oggetto
(setq tipo (cdr (assoc 0 lista))) ;-----tipo oggetto
)
)
)
;Funzione che indica quanto manca in percentuale alla fine del LISP
(defun sequenza (/ perc stringa)
(setq perc (/ (* n 100) n_ent))
(setq perc (rtos perc 2 0))
(setq stringa (strcat "Percentuale: " perc "% ."))
(setvar "modemacro" stringa)
)
