geo04

Téléchargeagle dans la rubrique AUTOCAD >>>>LISP et visualLISP http://www.cadxp.com/UpDownload+index-req-viewsdownload-sid-7.html Tu peux y trouver: tra.lsp ,lon.lsp ,rect.lsp ,gel.lsp ,efe.lsp

m'excuse j'avais pas fait gaffe à forum LT ,et tu as raison!!!je suis nouveau et j'ai un peu de mal à naviguer

Pour mettre les pendules à l'heure si ça peut te servir (defun C:HORLOGE () (setq amjh (rtos (getvar "cdate" ) 2 6) ans (substr amjh 1 4) moi (substr amjh 5 2) jou (substr amjh 7 2) heu (substr amjh 10 2) min (substr amjh 12 2) sec (substr amjh 14 2) ) (setq mois (cond ((eq moi "01") "JANVIER" ) ((eq moi "02") "FEVRIER" ) ((eq moi "03") "MARS" ) ((eq moi "04") "AVRIL" ) ((eq moi "05") "MAI" ) ((eq moi "06") "JUIN" ) ((eq moi "07") "JUILLET" ) ((eq moi "08") "AOUT") ((eq moi "09") "SEPTEMBRE" ) ((eq moi "10") "OCTOBRE" ) ((eq moi "11") "NOVEMBRE" ) ((eq moi "12") "DECEMBRE" ) ) ) (prompt "\n==========================================================================") (prompt (strcat "\n =======> "jou " " mois " " ans " ====> " heu ":" min ":" sec )) (princ) ) ////////////////////////////////

Avec ça il est possible de dessiner des rectangles en tous sens et meme plus le choix des calques permet d'avoir un coté du rectangle non solidaire du reste ;RECT.LSP perpendiculaire** RG juillet 1992 ;****************************** ( defun C:RECT(/ anccmd ancfla ancerr ancosm ancbli anclpa ) ;sauvegarde de l' environnement de la commande avant execution ;************************************************************* (setq anccmd (getvar "cmdecho" ) ancerr *error* ancosm (getvar "osmode" ) ancbli (getvar "blipmode" ) ancpla (getvar "clayer" ) ); fin setq ;redefinition du traitement des erreurs ;************************************** (defun *error* (msg) (terpri) (command "calque" "ch" ancpla "") (princ msg) (setvar "cmdecho" anccmd) (setvar "osmode" ancosm) (setvar "blipmode" ancbli) (setq *error* ancerr) (princ) );fin defun error ;definition du nouvel environnement de la commande ;************************************************* (setvar "cmdecho" 0 ) (setvar "blipmode" 0 ) (setvar "osmode" 8 );nodal ;saisie des donnees ;****************** (if ( = pl0 nil) (setq pl0 "bt") ) (if ( = pl3 nil) (setq pl3 "bt") ) (setq pl1 (getstring (strcat "\n calque ligne<"pl0">:"))) (if (= pl1 "") (setq pl1 pl0) ) (setq pl2 (getstring (strcat "\n calque ligne provi <"pl3">:"))) (if (= pl2 "") (setq pl2 pl3) ) (setq pt1 (getpoint "\n 1ø point:")) ; (while (/= pt1 nil ) (setq pt2 ( getpoint pt1 "\n 2ø point:")) ;*********calcul pt1 pt2****** (setq dx (expt (- (car pt1) (car pt2)) 2 )) (setq dy (expt (- (cadr pt1) (cadr pt2)) 2 )) (setq dist (sqrt (+ dx dy ))) (prompt (strcat "\n Distance pt1 pt2=====>" (rtos dist 2 3) "m" )) (if (= lon nil) (setq lon dist) ) (setq long ( getdist pt1 (strcat "\n longueur de la perpendiculaire <" (rtos lon 2 3)" >:"))) (if (= long nil) (setq long lon ) ) ; (setq dir ( getpoint pt1 "\n Position de la perp:")) (while (= dir nil) (setq dir ( getpoint pt1 "\n Position de la perp:")) ) ;*******calcul pt1 dir****** (setq dx (expt (- (car pt1) (car dir)) 2 )) (setq dy (expt (- (cadr pt1) (cadr dir)) 2 )) (setq dis (sqrt (+ dx dy ))) ;*******calcul pt2 dir****** (setq dx (expt (- (car pt2) (car dir)) 2 )) (setq dy (expt (- (cadr pt2) (cadr dir)) 2 )) (setq di (sqrt (+ dx dy ))) ;********calcul de la perp****** (setq di (* di di)) (setq dis (* dis dis)) (setq dista (* dist 2)) (setq dist (* dist dist)) (setq x (+ (- dis di) dist)) (setq x (/ x dista)) (setq y (sqrt (- dis x))) ;*********calcul de x sur la base (setq ang (angle pt1 pt2)) (setq ptx (polar pt1 ang x)) (setq ang1 ( angle ptx dir )) (setq pt3 ( polar pt1 ang1 long )) (setq pt4 ( polar pt2 ang1 long )) (setvar "osmode" 0 );aucun ; (command "calque" "e" pl2 "") (command "polylign" pt3 pt4 "" ) (setq l1 (entlast)) (if (= pl2 pl1) (command "effacer" "d" "") ) ; (command "calque" "e" pl1 "") (command "polylign" pt4 pt2 pt1 pt3 "" ) (setq l2 (entlast)) (if (= pl2 pl1) (command "pedit" "d" "c" "") ) ; (setvar "osmode" 8 ) (setq lon long) (setq pl0 pl1) (setq pl3 pl2) (setq pt1 ( getpoint "\n 1ø point:")) );fin while ;retablissement environnement de la commande ;******************************************** (command "calque" "ch" ancpla "" ) ;(setvar "flatland" ancfla ) (setvar "blipmode" ancbli ) (setvar "cmdecho" anccmd ) (setvar "osmode" ancosm ) (setq *error* ancerr ) (princ);sortie tranquille );fin defun

en principe cela devrait etre dans les nouveautés à télécharger!!

tra.lsp (profil en travers) est téléchargeable ,le profil en long suit!!!

Je désire mettre des routines à disposition, c'est gratuit (profil en long ,en travers,cotation ,rectangle,trilatération. écriture de fichier point , implantation etc ainsi que quelques utilitaires )