Creation d\'axe en lsp autocad pour Piste

zizouspawn · le 21 février 2007

Salut à tous,

je boss sur tocad 2002 et piste 5.2

Auriez vous un prog "lsp" qui me cré mon axe avec les points les droites les cercles etc...

Merci d'avance....

didier · le 21 février 2007

hello,

dois-je comprendre que tu parles d'axe en plan ?

de quoi pars tu ?

un listing avec la définition géométrique ?

des éléments graphiques AutoCad ?

quid des clothoïdes ?

amicalement

bonuscad · le 24 février 2007

Je n'ai pus encore le tester avec la version 5.2 de piste. Il fonctionne avec les versions précédentes.

Je te donne le code source, libre à toi de le modifier s'il le faut.

Le but de cette routine est de créer un fichier à extension .CAP (Commande Axe en Plan) que tu pourras lire dans le module axe en plan de piste avec la commande LIRE.

Cette routine pouvait lire les clothoîde mise en place avec un applicatif nommé "OUTICAD" (ancienne version)

Soit du adaptes ceci, soit tu fais l'impasse sur celles-ci, pour les construire ultérieurement dans piste en récupérant seulement les éléments de bases qui serviront à la construction.

Il se peut qu'une certaine imprécision empêche la liaisons dans piste. Le mieux dans cas est de reconstruire les élément de liaisons sous piste.

Cette routine n'est pas parfaite, mais peut être utile comme passerelle entre Autocad et Piste et t'éviteras tout un travail de saisie fastidieux.

(defun piserr (ch)
(cond
	((eq ch "Function cancelled") nil)
	((eq ch "quit / exit abort") nil)
	((eq ch "console break") nil)
	(T (princ ch))
)
(redraw)
(if (= sv_ucs 0)
	(progn
		(command "._ucs" "_restore" "$_TEMPO_$")
		(command "._ucs" "_delete" "$_TEMPO_$")
	)
)
(setvar "blipmode" sv_blp)
(setvar "osmode" sv_osm)
(setq *error* olderr)
(setvar "cmdecho" 1)
(princ)
)
(defun sel_al ( / s_sel pt_sel pt_tmp al_p param)
(prompt "\nRécupère le paramètre, le ripage, la longueur et le rayon au sommet")
(prompt "\nd'une clothoïde construite sous OUTICAD V 1.2 ou V 2.01")
(while (not (setq s_sel (entsel "\nChoisissez une liaison : "))))
(setq pt_sel (osnap (cadr s_sel) "_nearest")
      pt_tmp (osnap (cadr s_sel) "_end")
      s_sel (entget (car s_sel) '("OUTICAD"))
      al_p nil param (cdadr (assoc -3 s_sel))
)
(cond
	((= (cdr (assoc 0 s_sel)) "INSERT")
		(setq s_sel (tblsearch "BLOCK" (cdr (assoc 2 s_sel))))
		(setq s_sel (entnext (cdr (assoc -2 s_sel))))
		(while (/= s_sel nil)
			(if (= (cdr (assoc 0 (entget s_sel))) "ATTDEF")
				(setq al_p (entget s_sel))
			)
			(setq s_sel (entnext s_sel))
		)
		(cond
			((not (null al_p))
				(setq al_p (cdr (assoc 1 al_p)))
				(cond
					((= (substr al_p 1 10) "CLOTHOIDE_")
						(if (= (length nn) 0)
							(setq nn '(0))
						)
						(setq nn (cons (1+ (car nn)) nn))
						(if (<= (if nl (+ (* 2 (car nn)) (car nl)) (* 2 (car nn))) 50)
							(progn
								(setq stk_al
									(cons
										(list
											(distof (substr al_p 11 20) 1)
											(distof (substr al_p 31 20) 1)
											(distof (substr al_p 51 20) 1)
											(if (zerop (distof (substr al_p 71 20) 1))
												(/
													(expt (distof (substr al_p 11 20) 1) 2)
													(distof (substr al_p 51 20) 1)
												)
												(/
													(expt (distof (substr al_p 11 20) 1) 2)
													(distof (substr al_p 71 20) 1)
												)
											)
										)
										stk_al
									)
								)
								(sens_e pt_sel pt_tmp (last (car stk_al)) "PARAM")
								(initget "Oui Non")
								(if (eq (getkword "\nInversion du sens de parcours [Oui/Non]? < Non >: ") "Oui")
									(progn
										(sens_e pt_sel pt_tmp (- (last (car stk_al))) "PARAM")
										(setq stk_al
											(cons
												(reverse
													(cons
														(- (last (car stk_al)))
														(cdr (reverse (car stk_al)))
													)
												)
												(cdr stk_al)
											)
										)
									)
								)
								(displ (cons (car nn) '(0)) (list (car stk_al)) "PARAM" nil)
							)
							(progn
								(prompt "\nLimite des 50 distances dépassée")
								(setq nn (cdr nn) avec nil)
							)
						)
					)
					(T (prompt "\nN'est pas une clotoïde") (sel_al))
				)
			)
			((eq (cdr (assoc 1000 param)) "CLOTHOIDE")
				(while param
					(if (eq (caar param) 1040)
						(setq al_p (cons (cdar param) al_p))
					)
					(setq param (cdr param))
				)
				(if (= (length nn) 0)
					(setq nn '(0))
				)
				(setq nn (cons (1+ (car nn)) nn))
				(if (<= (if nl (+ (* 2 (car nn)) (car nl)) (* 2 (car nn))) 50)
					(progn
						(setq stk_al
							(cons
								(list
									(cadddr al_p)
									(cadr al_p)
									(last al_p)
									(* (car al_p) (/ (expt (cadddr al_p) 2) (last al_p)))
								)
								stk_al
							)
						)
						(displ (cons (car nn) '(0)) (list (car stk_al)) "PARAM" nil)
					)
					(progn
						(prompt "\nLimite des 50 distances dépassée")
						(setq nn (cdr nn) avec nil)
					)
				)
			)
			(T (prompt "\nCe bloc n'est pas une clothoïde!") (sel_al))
		)
	)
	(T (prompt "\nEntité selectionnée n'est pas une liaison") (sel_al))
)
)
(defun sens_e (pt pt1 pt2 typ_e / rap sens_v pt1_f pt2_f)
(redraw)
(setq rap (/ (getvar "viewsize") 50))
(cond
	((eq typ_e "DROite")
		(setq sens_v (angle pt2 pt1))
	)
	((eq typ_e "CERcle")
		(if (> pt2 0)
			(setq sens_v (+ (angle pt1 pt) (/ pi 2)))
			(setq sens_v (- (angle pt1 pt) (/ pi 2)))
		)
	)
	((eq typ_e "PARAM")
		(setq sens_v (angle pt pt1))
		(if (> pt2 0)
			(if (< sens_v pi)
				(setq sens_v (- sens_v pi))
			)
			(if (> sens_v pi)
				(setq sens_v (+ sens_v pi))
			)
		)
	)
)
	(setq pt1_f (polar pt (+ sens_v (/ (* 3 pi) 4)) rap)
      pt2_f (polar pt (- sens_v (/ (* 3 pi) 4)) rap)
)
(grdraw pt1_f pt 3)	(grdraw pt pt2_f 3)
)
(defun choice (msg_c lst_c car_c mod_c act_c / q?_el nbr nbr_al vraid vraic vrail)
(textscr)
(setq q?_el (getstring msg_c))
(if (zerop (atoi q?_el))
	(setq q?_el (atoi (substr q?_el 3)))
	(setq q?_el (atoi q?_el))
)
(cond
	((not (zerop q?_el))
		(if (member q?_el lst_c)
			(progn
				(setq nbr (- (length lst_c) (length (member q?_el lst_c))))
				(prompt
					(cond
						((and act_c (eq mod_c "POInt"))
							"\nSuppresion du point"
						)
						((and act_c (eq mod_c "DIStance"))
							"\nSuppresion de la distance"
						)
						((and act_c (eq mod_c "DROite"))
							"\nSuppression de la droite"
						)
						((and act_c (eq mod_c "CERcle"))
							"\nSuppression du cercle"
						)
						((and act_c (eq mod_c "LIAison"))
							"\nSuppression de la liaison"
						)
						((and (not act_c) (eq mod_c "POInt"))
							"\nUtilisation du point"
						)
						((and (not act_c) (eq mod_c "DIStance"))
							"\nUtilisation de la distance"
						)
						((and (not act_c) (eq mod_c "DROite"))
							"\nUtilisation de la droite"
						)
						((and (not act_c) (eq mod_c "CERcle"))
							"\nUtilisation du cercle"
						)
					)
				)
				(displ (cons (nth nbr lst_c) '(0)) (list (nth nbr car_c)) mod_c nil)
				(if act_c
					(progn
						(cond
							((eq mod_c "POInt")
								(foreach n stk_dr (if (member q?_el n) (setq vraid T)))
								(foreach n stk_cr (if (eq q?_el (cadr n)) (setq vraic T)))
								(cond
									(vraid
										(prompt "\nPoint utilisé dans définition de droite, effacez d'abord la droite")
										(setq nw_lst lst_c nw_car car_c)
									)
									(vraic
										(prompt "\nPoint utilisé dans définition de cercle, effacez d'abord le cercle")
										(setq nw_lst lst_c nw_car car_c)
									)
									(T
										(setq nw_lst (delete lst_c (nth nbr lst_c))
										      nw_car (delete car_c (nth nbr car_c))
										)
									)
								)
								(setq vraid nil vraic nil)
							)
							((eq mod_c "DIStance")
								(foreach n stk_cr (if (eq q?_el (car n)) (setq vraic T)))
								(cond
									(vraic
										(prompt "\nDistance utilisée dans définition de cercle, effacez d'abord le cercle")
										(setq nw_lst lst_c nw_car car_c)
									)
									(T
										(setq nw_lst (delete lst_c (nth nbr lst_c))
										      nw_car (delete car_c (nth nbr car_c))
										)
									)
								)
								(setq vraic nil)
							)
							((eq mod_c "DROite")
								(foreach n stk_li
									(if (and (eq (nth 5 n) mod_c) (eq q?_el (nth 6 n)))
										(setq vrail T)
									)
									(if (and (eq (nth 7 n) mod_c) (eq q?_el (nth 8 n)))
										(setq vrail T)
									)
								)
								(if vrail
									(progn
										(prompt "\nDroite utilisé dans définition de liaison, effacez d'abord la liaison")
										(setq nw_lst lst_c nw_car car_c)
									)
									(setq nw_lst (delete lst_c (nth nbr lst_c))
									      nw_car (delete car_c (nth nbr car_c))
									)
								)
								(setq vrail nil)
							)
							((eq mod_c "CERcle")
								(foreach n stk_li
									(if (and (eq (nth 5 n) mod_c) (eq q?_el (nth 6 n)))
										(setq vrail T)
									)
									(if (and (eq (nth 7 n) mod_c) (eq q?_el (nth 8 n)))
										(setq vrail T)
									)
								)
								(if vrail
									(progn
										(prompt "\nCercle utilisé dans définition de liaison, effacez d'abord la liaison")
										(setq nw_lst lst_c nw_car car_c)
									)
									(setq nw_lst (delete lst_c (nth nbr lst_c))
									      nw_car (delete car_c (nth nbr car_c))
									)
								)
								(setq vrail nil)
							)
							((eq mod_c "LIAison")
								(if (= (type (cadddr (nth nbr car_c))) 'INT)
									(progn
										(if (member (cadddr (nth nbr car_c)) nn)
											(progn
												(setq nbr_al
													(-
														(length nn)
														(length (member (cadddr (nth nbr car_c)) nn))
													)
												)
												(setq nn (delete nn (nth nbr_al	nn)))
												(setq stk_al (delete stk_al (nth nbr_al stk_al)))
											)
										)
									)
								)
								(if (= (type (car (nth nbr car_c))) 'INT)
									(progn
										(if (member (car (nth nbr car_c)) nn)
											(progn
												(setq nbr_al
													(-
														(length nn)
														(length (member (car (nth nbr car_c)) nn))
													)
												)
												(setq nn (delete nn (nth nbr_al	nn)))
												(setq stk_al (delete stk_al (nth nbr_al stk_al)))
											)
										)
									)
								)
								(setq nw_lst (delete lst_c (nth nbr lst_c))
								      nw_car (delete car_c (nth nbr car_c))
								)
							)
						)
					)
					(progn
						(setq cmpt (1+ cmpt))
						(list (nth nbr lst_c))
					)
				)
			)
			(progn
				(setq nw_lst lst_c nw_car car_c)
				(prompt
					(cond
						((eq mod_c "POInt")
							"\nPas de point correspondant"
						)
						((eq mod_c "DIStance")
							"\nPas de distance correspondante"
						)
						((eq mod_c "DROite")
							"\nPas de droite correspondante"
						)
						((eq mod_c "CERcle")
							"\nPas de cercle correspondant"
						)
						((eq mod_c "LIAison")
							"\nPas de liaison correspondante"
						)
					)
				)
			)
		)
	)
	(T 
		(setq nw_lst lst_c nw_car car_c)
		(prompt "\nLibellé incorrect")
	)
)
)
(defun displ (lst_a car_a mod_a wrt / strcmd)
(mapcar
	'(lambda (x y)
		(setq strcmd
			(cond
				((eq mod_a "POInt")
					(strcat
						(if (< x 100)
							"\nPOI PT"
							"\nPOI P"
						)
						(itoa x)
						" "
						(rtos (car y) 2 4)
						" "
						(rtos (cadr y) 2 4)
					)
				)
				((eq mod_a "DIStance")
					(strcat
						"\nDIS LG"
						(itoa x)
						" "
						(rtos y 2 4)
					)
				)
				((eq mod_a "DROite")
					(strcat
						"\nDRO DR"
						(itoa x)
						" PT"
						(itoa (cadr y))
						" PT"
						(itoa (car y))
					)
				)
				((eq mod_a "CERcle")
					(strcat
						"\nCER CR"
						(itoa x)
						" PT"
						(itoa (cadr y))
						" LG"
						(itoa (car y))
					)
				)
				((eq mod_a "PARAM")
					(strcat
						"\nDIS AL"
						(itoa x)
						" "
						(rtos (car y) 2 4)
						(if wrt
							""
							(progn
								(strcat
									"\nDIS RP"
									(itoa x)
									" "
									(rtos (cadr y) 2 4)
									"\nDIS LC"
									(itoa x)
									" "
									(rtos (caddr y) 2 4)
								)
							)
						)
						"\nDIS RS"
						(itoa x)
						" "
						(rtos (cadddr y) 2 4)
					)
				)
				((eq mod_a "LIAison")
					(strcat
						"\nLIA LI"
						(itoa x)
						(if (= (cadr (reverse y)) "DROite")
							" DR"
							" CR"
						)
						(itoa (last y))
						(if (= (cadddr (reverse y)) "DROite")
							" DR"
							" CR"
						)
						(itoa (caddr (reverse y)))
						(if	(not (car (cddddr y)))
							""
							(car (cddddr y))
						)
						(if (numberp (cadddr y))
							(strcat " AL" (itoa (cadddr y)))
							""
						)
						(if (numberp (caddr y))
							(strcat " RS" (itoa (caddr y)))
							(if (not (caddr y))
								""
								(caddr y)
							)
						)
						(if	(not (cadr y))
							""
							(cadr y)
						)
						(if (numberp (car y))
							(strcat " AL" (itoa (car y)))
							""
						)
					)
				)
			)
		)
		(if wrt (write-line strcmd fic) (prompt strcmd))
	)
	(cdr (reverse lst_a))
	(reverse car_a)
)
)
(defun delete (lst_d rep_d / )
(append
	(reverse (cdr (member rep_d (reverse lst_d))))
	(cdr (member rep_d lst_d))
)
)
(defun msg_cm (t_mod / )
(if (not svk_el) (setq svk_el "DROite") (setq svk_el key_el))
(initget "POInt DIStance DROite CERcle LIAison SORtir")
(setq key_el
	(getkword
		(strcat
			t_mod
			"de [POInt/DIStance/DROite/CERcle/LIAison/SORtir]< "
			svk_el
			" >: "
		)
	)
)
(if (not key_el) (setq key_el svk_el) key_el)
)
(defun cr_ele ( / typ_el s_point s_sel mod_cr cmpt avec pt_sel)
(while (/= (setq typ_el (msg_cm "\nMode Création ")) "SORtir")
	(cond
		((eq typ_el "POInt")
			(if (= (length np) 0)
				(setq np '(0))
			)
			(setq np (cons (1+ (car np)) np))
			(if (<= (car np) 100)
				(progn
					(initget 9)
					(setq s_point (getpoint "\nPoint ?: "))
					(setq stk_pt (cons (list (car s_point) (cadr s_point)) stk_pt))
					(displ (cons (car np) '(0)) (list (car stk_pt)) typ_el nil)
				)
				(progn
					(prompt "\nLimite des 100 points dépassée")
					(setq np (cdr np))
				)
			)
		)
		((eq typ_el "DIStance")
			(if (= (length nl) 0)
				(setq nl '(0))
			)
			(setq nl (cons (1+ (car nl)) nl))
			(if (<= (if nn (+ (* 2 (car nn)) (car nl)) (car nl)) 50)
				(progn
					(setq s_sel (entsel "\nChoisissez une ligne, un arc, un cercle ou < RETURN pour valeur > : "))
					(cond
						((null s_sel)
							(initget 65)
							(setq stk_di (cons (getdist "\nEntrez distance : ") stk_di))
							(displ (cons (car nl) '(0)) (list (car stk_di)) typ_el nil)
						)
						((= (cdr (assoc 0 (entget (car s_sel)))) "LINE")
							(setq s_sel (entget (car s_sel)))
							(setq stk_di (cons (distance (cdr (assoc 10 s_sel)) (cdr (assoc 11 s_sel))) stk_di))
							(displ (cons (car nl) '(0)) (list (car stk_di)) typ_el nil)
						)
						((or
							(= (cdr (assoc 0 (entget (car s_sel)))) "CIRCLE")
							(= (cdr (assoc 0 (entget (car s_sel)))) "ARC")
				 		)
							(setq s_sel (entget (car s_sel)))
							(setq stk_di (cons (cdr (assoc 40 s_sel)) stk_di))
							(displ (cons (car nl) '(0)) (list (car stk_di)) typ_el nil)
						)
						(T
							(prompt "\nEntité selectionnée n'est pas une ligne, un arc ou un cercle")
							(setq nl (cdr nl))
						)
					)
				)
				(progn
					(prompt "\nLimite des 50 distances dépassée")
					(setq nl (cdr nl))
				)
			)
		)
		((eq typ_el "DROite")
			(if (= (length nd) 0)
				(setq nd '(0))
			)
			(setq nd (cons (1+ (car nd)) nd))
			(if (<= (car nd) 50)
				(progn
					(initget "Existants")
					(setq mod_cr (getkword "\nDroite avec points [Existants]/< RETURN pour selection ligne >: "))
					(cond
						((eq mod_cr "Existants")
							(cond
								((> (length np) 2)
									(setq cmpt 0)
									(while (< cmpt 2)
										(displ np stk_pt "POInt" nil)
										(setq avec (append (choice "\nLibellé du point à utiliser ?: " np stk_pt "POInt" nil) avec))
									)
									(if
										(= (car avec) (cadr avec))
										(progn
											(prompt "\nIncorrect, le point est identique au premier")
											(setq nd (cdr nd) avec nil)
										)
										(progn
											(setq stk_dr (cons avec stk_dr) avec nil)
											(displ (cons (car nd) '(0)) (list (car stk_dr)) typ_el nil)
										)
									)
								)
								(T
									(if (< (length np) 1)
										(prompt "\nAucun point défini")
										(prompt "\nPas assez de points définis")
									)
									(setq nd (cdr nd))
								)
							)
						)
						(T
							(while (not (setq s_sel (entsel "\nChoisissez une ligne : "))))
							(setq pt_sel (osnap (cadr s_sel) "_nearest")
					  		    s_sel (entget (car s_sel))
							)
							(cond
								((= (cdr (assoc 0 s_sel)) "LINE")
									(if (= (length np) 0)
										(setq np '(0))
									)
									(setq np (cons (1+ (car np)) np))
									(if (<= (car np) 100)
										(progn
											(setq stk_pt (cons (list (cadr (assoc 10 s_sel)) (caddr (assoc 10 s_sel))) stk_pt))
											(displ (cons (car np) '(0)) (list (car stk_pt)) "POInt" nil)
											(setq np (cons (1+ (car np)) np))
											(setq stk_pt (cons (list (cadr (assoc 11 s_sel)) (caddr (assoc 11 s_sel))) stk_pt))
											(displ (cons (car np) '(0)) (list (car stk_pt)) "POInt" nil)
											(sens_e pt_sel (car stk_pt) (cadr stk_pt) typ_el)
											(initget "Oui Non")
											(if (eq (getkword "\nInversion du sens de parcours [Oui/Non]? < Non >: ") "Oui")
												(progn
													(sens_e pt_sel (cadr stk_pt) (car stk_pt) typ_el)
													(setq stk_dr (cons (list (cadr np) (car np)) stk_dr))
												)
												(setq stk_dr (cons (list (car np) (cadr np)) stk_dr))
											)
											(displ (cons (car nd) '(0)) (list (car stk_dr)) typ_el nil)
										)
										(progn
											(prompt "\nLimite des 100 points dépassée")
											(setq np (cdr np) nd (cdr nd))
										)
									)
								)
								(T
									(prompt "\nEntité selectionnée n'est pas une ligne")
									(setq nd (cdr nd))
								)
							)
						)
					)
				)
				(progn
					(prompt "\nLimite des 50 droites dépassée")
					(setq nd (cdr nd))
				)
			)
		)
		((eq typ_el "CERcle")
			(if (= (length nc) 0)
				(setq nc '(0))
			)
			(setq nc (cons (1+ (car nc)) nc))
			(if (<= (car nc) 50)
				(progn
					(initget "Existants")
					(setq mod_cr (getkword "\nCercle avec points et distances [Existants]/< RETURN pour selection cercle >: "))
					(cond
						((eq mod_cr "Existants")
							(cond
								((and (> (length np) 1) (> (length nl) 1))
									(setq cmpt 0)
									(while (< cmpt 1)
										(displ np stk_pt "POInt" nil)
										(setq avec (choice "\nLibellé du point à utiliser ?: " np stk_pt "POInt" nil))
									)
									(while (< cmpt 2)
										(displ nl stk_di "DIStance" nil)
										(setq avec (append (choice "\nLibellé de la distance à utiliser ?: " nl stk_di "DIStance" nil) avec))
									)
									(setq stk_cr (cons avec stk_cr) avec nil)
									(displ (cons (car nc) '(0)) (list (car stk_cr)) typ_el nil)
								)
								(T
									(if (<= (length np) 1)
										(prompt "\nAucun point défini")
									)
									(if (<= (length nl) 1)
										(prompt "\nAucune distance définie")
									)
									(setq nc (cdr nc))
								)
							)
						)
						(T
							(while (not (setq s_sel (entsel "\nChoisissez un arc ou un cercle : "))))
							(setq pt_sel (osnap (cadr s_sel) "_nearest")
							      s_sel (entget (car s_sel))
							)
							(cond
								((or
									(= (cdr (assoc 0 s_sel)) "ARC")
									(= (cdr (assoc 0 s_sel)) "CIRCLE")
						 		)
									(if (= (length np) 0)
										(setq np '(0))
									)
									(if (= (length nl) 0)
										(setq nl '(0))
									)
									(setq np (cons (1+ (car np)) np))
									(if (<= (car np) 100)
										(progn
											(setq nl (cons (1+ (car nl)) nl))
											(if (<= (if nn (+ (* 2 (car nn)) (car nl)) (car nl)) 50)
												(progn
													(setq stk_pt (cons (list (cadr (assoc 10 s_sel)) (caddr (assoc 10 s_sel))) stk_pt))
													(displ (cons (car np) '(0)) (list (car stk_pt)) "POInt" nil)
													(setq stk_di (cons (cdr (assoc 40 s_sel)) stk_di))
													(sens_e pt_sel (car stk_pt) (car stk_di) typ_el)
													(initget "Oui Non")
													(if (eq (getkword "\nInversion du sens de parcours [Oui/Non]? < Non >: ") "Oui")
														(progn
															(sens_e pt_sel (car stk_pt) (- (car stk_di)) typ_el)
															(setq stk_di (cons (- (car stk_di)) (cdr stk_di)))
														)
													)
													(displ (cons (car nl) '(0)) (list (car stk_di)) "DIStance" nil)
													(setq stk_cr (cons (list (car nl) (car np)) stk_cr))
													(displ (cons (car nc) '(0)) (list (car stk_cr)) typ_el nil)
												)
												(progn
													(prompt "\nLimite des 50 distances dépassée")
													(setq nl (cdr nl) nc (cdr nc))
												)
											)
										)
										(progn
											(prompt "\nLimite des 100 points dépassée")
											(setq np (cdr np) nc (cdr nc))
										)
									)
								)
								(T
									(prompt "\nEntité selectionnée n'est pas un arc ou un cercle")
									(setq nc (cdr nc))
								)
							)
						)
					)
				)
				(progn
					(prompt "\nLimite des 50 cercles dépassée")
					(setq nc (cdr nc))
				)
			)
		)
		((eq typ_el "LIAison")
			(if (= (length nr) 0)
				(setq nr '(0))
			)
			(setq nr (cons (1+ (car nr)) nr))
			(if (<= (car nr) 50)
				(progn
					(initget 1 "CL CES CLDRCL Ove CEC CAS CLCECL")
					(setq mod_cr (getkword "\nLiaison avec [CL/CES/CLDRCL/Ove/CEC/CAS/CLCECL]?: "))
					(cond
						((or (eq mod_cr "CLCECL")	(eq mod_cr "CAS"))
							(cond
								((> (length nd) 2)
									(setq cmpt 0)
									(while (< cmpt 1)
										(displ nd stk_dr "DROite" nil)
										(setq avec (cons "DROite" (choice "\nLibellé de la 1ère droite à utiliser ?: " nd stk_dr "DROite" nil)))
									)
									(while (< cmpt 2)
										(displ nd stk_dr "DROite" nil)
										(setq avec
											(append
												(cons "DROite" (choice "\nLibellé de la 2ème droite à utiliser ?: " nd stk_dr "DROite" nil))
												avec
											)
										)
									)
									(if (= (cadr avec) (cadddr avec))
										(progn
											(prompt "\nIncorrect, l'élément est identique au premier")
											(setq nr (cdr nr) avec nil)
										)
										(progn
											(prompt "\nSelection de la 1ère clothoïde")
											(sel_al)
											(initget "Symetrique Dissymetrique")
											(if (eq (getkword "\n[symetrique/Dissymetrique] < Symetrique >: ") "Dissymetrique")
												(progn
													(prompt "\nSelection de la 2ème clothoïde")
													(sel_al)
													(while
														(and
															(equal (caar stk_al) (caadr stk_al) 0.0001)
															(not (equal (last (car stk_al)) (last (cadr stk_al)) 0.0001))
														)
														(prompt "\nIncorrect, paramètres égaux ou rayons au sommet différents")
														(setq stk_al (cdr stk_al) nn (cdr nn))
														(sel_al)
													)
													(if (eq mod_cr "CAS")
														(setq stk_li (cons (append (list (car nn) nil (cadr nn) (cadr nn) nil) avec) stk_li))
														(setq stk_li (cons (append (list (car nn) " PARA" (cadr nn) (cadr nn) " PARA") avec) stk_li))
													)
												)
												(if (eq mod_cr "CAS")
													(setq stk_li (cons (append (list nil nil " NUL" (car nn) nil) avec) stk_li))
													(setq stk_li (cons (append (list (car nn) " PARA" (car nn) (car nn) " PARA") avec) stk_li))
												)
											)
										)
									)
								)
								(T
									(prompt "\nPas assez de droites définies")
									(setq nr (cdr nr))
								)
							)
						)
						((or (eq mod_cr "CLDRCL")	(eq mod_cr "CES") (eq mod_cr "Ove") (eq mod_cr "CEC"))
							(cond
								((> (length nc) 2)
									(setq cmpt 0)
										(while (< cmpt 1)
										(displ nc stk_cr "CERcle" nil)
										(setq avec (cons "CERcle" (choice "\nLibellé du 1er cercle à utiliser ?: " nc stk_cr "CERcle" nil)))
									)
									(while (< cmpt 2)
										(displ nc stk_cr "CERcle" nil)
										(setq avec
											(append
												(cons "CERcle" (choice "\nLibellé du 2ème cercle à utiliser ?: " nc stk_cr "CERcle" nil))
												avec
											)
										)
									)
									(if (= (cadr avec) (cadddr avec))
										(progn
											(prompt "\nIncorrect, l'élément est identique au premier")
											(setq nr (cdr nr) avec nil)
										)
										(cond
											((/= mod_cr "Ove")
												(prompt "\nSelection de la 1ère clothoïde")
												(sel_al)
												(initget "Symetrique Dissymetrique")
												(if (eq (getkword "\n[symetrique/Dissymetrique] < Symetrique >: ") "Dissymetrique")
													(progn
														(prompt "\nSelection de la 2ème clothoïde")
														(sel_al)
														(while
															(and
																(equal (caar stk_al) (caadr stk_al) 0.0001)
																(not (equal (last (car stk_al)) (last (cadr stk_al)) 0.0001))
															)
															(prompt "\nIncorrect, paramètres égaux ou rayons au sommet différents")
															(setq stk_al (cdr stk_al) nn (cdr nn))
															(sel_al)
														)
														(cond
															((eq mod_cr "CLDRCL")
																(setq stk_li (cons (append (list (car nn) " PARA" nil (cadr nn) " PARA") avec) stk_li))
															)
															((eq mod_cr "CES")
																(setq stk_li (cons (append (list (car nn) nil nil (cadr nn) nil) avec) stk_li))
															)
															((eq mod_cr "CEC")
																(setq stk_li (cons (append (list (car nn) nil (cadr nn) (cadr nn) nil) avec) stk_li))
															)
														)
													)
													(cond
														((eq mod_cr "CLDRCL")
															(setq stk_li (cons (append (list (car nn) " PARA" nil (car nn) " PARA") avec) stk_li))
														)
														((eq mod_cr "CES")
															(setq stk_li (cons (append (list nil nil nil nil " SSYM") avec) stk_li))
														)
														((eq mod_cr "CEC")
															(setq stk_li (cons (append (list (car nn) nil (car nn) (car nn) nil) avec) stk_li))
														)
													)
												)
											)
											(T
												(setq stk_li (cons (append (list nil nil nil nil " COVE") avec) stk_li))
											)
										)
									)
								)
								(T
									(prompt "\nPas assez de cercles définis")
									(setq nr (cdr nr))
								)
							)
						)
						(T
							(cond
								((and (> (length nc) 1) (> (length nd) 1))
									(setq cmpt 0)
									(initget "CERcle DROite")
									(if (eq (getkword "\n1er élément est un(e) [DROite/CERcle]? < DROite >: ") "CERcle")
										(progn
											(while (< cmpt 2)
												(displ nc stk_cr "CERcle" nil)
												(setq avec (cons "CERcle" (choice "\nLibellé du cercle à utiliser ?: " nc stk_cr "CERcle" nil)))
												(displ nd stk_dr "DROite" nil)
												(setq avec (append (cons "DROite" (choice "\nLibellé de la droite à utiliser ?: " nd stk_dr "DROite" nil)) avec))
											)
										)
										(progn
											(while (< cmpt 2)
												(displ nd stk_dr "DROite" nil)
												(setq avec (cons "DROite" (choice "\nLibellé de la droite à utiliser ?: " nd stk_dr "DROite" nil)))
												(displ nc stk_cr "CERcle" nil)
												(setq avec (append (cons "CERcle" (choice "\nLibellé du cercle à utiliser ?: " nc stk_cr "CERcle" nil)) avec))
											)
										)
									)
									(setq stk_li (cons (append (list nil nil nil nil nil) avec) stk_li))
								)
								(T
									(if (< (length nd) 1)
										(prompt "\nAucune droite définie")
									)
									(if (< (length nc) 1)
										(prompt "\nAucun cercle défini")
									)
									(setq nr (cdr nr))
								)
							)
						)
					)
					(if avec (displ (cons (car nr) '(0)) (list (car stk_li)) typ_el nil))
				)
				(progn
					(prompt "\nLimite des 50 liaisons dépassée")
					(setq nr (cdr nr))
				)
			)
			(if (not avec) (setq nr (cdr nr) stk_li (cdr stk_li)))
		)
	)
)
)
(defun ef_ele ( / typ_el nw_lst nw_car)
(while (/= (setq typ_el (msg_cm "\nMode Effacement ")) "SORtir")
	(cond
		((eq typ_el "POInt")
			(cond
				((> (length np) 1)
					(displ np stk_pt typ_el nil)
					(choice "\nLibellé du point à supprimer ?: " np stk_pt typ_el T)
					(setq np nw_lst stk_pt nw_car)
				)
				(T (prompt "\nAucun point défini") (setq np nil))
			)
		)
		((eq typ_el "DIStance")
			(cond
				((> (length nl) 1)
					(displ nl stk_di typ_el nil)
					(choice "\nLibellé de la distance à supprimer ?: " nl stk_di typ_el T)
					(setq nl nw_lst stk_di nw_car)
				)
				(T (prompt "\nAucun distance définie") (setq nl nil))
			)
		)
		((eq typ_el "DROite")
			(cond
				((> (length nd) 1)
					(displ nd stk_dr typ_el nil)
					(choice "\nLibellé de la droite à supprimer ?: " nd stk_dr typ_el T)
					(setq nd nw_lst stk_dr nw_car)
				)
				(T (prompt "\nAucun droite définie") (setq nd nil))
			)
		)
		((eq typ_el "CERcle")
			(cond
				((> (length nc) 1)
					(displ nc stk_cr typ_el nil)
					(choice "\nLibellé du cercle à supprimer ?: " nc stk_cr typ_el T)
					(setq nc nw_lst stk_cr nw_car)
				)
				(T (prompt "\nAucun cercle défini") (setq nc nil))
			)
		)
		((eq typ_el "LIAison")
			(cond
				((> (length nr) 1)
					(displ nr stk_li typ_el nil)
					(choice "\nLibellé de la liaison à supprimer ?: " nr stk_li typ_el T)
					(setq nr nw_lst stk_li nw_car)
				)
				(T (prompt "\nAucun liaison définie") (setq nr nil))
			)
		)
	)
)
)
(defun cr_com ( / fic)
(textscr)
(displ np stk_pt "POInt" nil)
(displ nl stk_di "DIStance" nil)
(displ nn stk_al "PARAM" nil)
(displ nd stk_dr "DROite" nil)
(displ nc stk_cr "CERcle" nil)
(displ nr stk_li "LIAison" nil)
(prompt "\n< -- Appuyer sur une touche pour continuer -- >")
(grread)
(graphscr)
(setq fic
	(getfiled
		"Nom du fichier de commande pour piste "
		(if (= (getvar "dwgtitled") 0) "" (strcat (getvar "dwgname") ".CAP"))
		"CAP" 7
	)
)
(cond
	(fic
		(setq fc_mem (open (strcat (getvar "dwgprefix") (getvar "dwgname") ".CMP") "w"))
		(prin1 np fc_mem)
		(princ "\n" fc_mem)
		(prin1 nl fc_mem)
		(princ "\n" fc_mem)
		(prin1 nd fc_mem)
		(princ "\n" fc_mem)
		(prin1 nc fc_mem)
		(princ "\n" fc_mem)
		(prin1 nr fc_mem)
		(princ "\n" fc_mem)
		(prin1 nn fc_mem)
		(princ "\n" fc_mem)
		(write-line 
			(strcat
				"("
				(apply
					'strcat
					(mapcar
						'(lambda (x)
							(strcat
								"("
								(rtos (car x) 2 14)
								" "	
								(rtos (cadr x) 2 14)
								")"
							)
						)
						stk_pt
					)
				)
				")"
			)
			fc_mem
		)
		(write-line 
			(strcat
				"("
				(apply
					'strcat
					(mapcar
						'(lambda (x)
							(strcat
								(rtos x 2 14)
								" "
							)
						)
						stk_di
					)
				)
				")"
			)
			fc_mem
		)
		(prin1 stk_dr fc_mem)
		(princ "\n" fc_mem)
		(prin1 stk_cr fc_mem)
		(princ "\n" fc_mem)
		(prin1 stk_li fc_mem)
		(princ "\n" fc_mem)
		(write-line 
			(strcat
				"("
				(apply
					'strcat
					(mapcar
						'(lambda (x)
							(strcat
								"("
								(rtos (car x) 2 14)
								" "	
								(rtos (cadr x) 2 14)
								" "
								(rtos (caddr x) 2 14)
								" "
								(rtos (cadddr x) 2 14)
								")"
							)
						)
						stk_al
					)
				)
				")"
			)
			fc_mem
		)
		(close fc_mem)
		(setq fic (open fic "w"))
		(displ np stk_pt "POInt" T)
		(displ nl stk_di "DIStance" T)
		(displ nn stk_al "PARAM" T)
		(displ nd stk_dr "DROite" T)
		(displ nc stk_cr "CERcle" T)
		(displ nr stk_li "LIAison" T)
		(close fic)
	)
	(T (prompt "\nAbandon de l'écriture du fichier"))
)
)
(defun c:piscom ( / sv_blp sv_osm sv_ucs olderr mod_c mod_sc svk_el key_el fc_mem)
(setvar "cmdecho" 0)
(setq sv_blp (getvar "blipmode"))
(setvar "blipmode" 1)
(setq sv_osm (getvar "osmode"))
(setvar "osmode" 0)
(setq sv_ucs (getvar "worlducs"))
(if (= sv_ucs 0)
	(progn
		(command "._ucs" "_save" "$_TEMPO_$")
		(command "_.ucs" "")
	)
)
(setq olderr *error* *error* piserr)
(while (/= mod_c "Fin")
	(if (not mod_sc) (setq mod_sc "CReation") (setq mod_sc mod_c))
	(initget "Reinit CHarge CReation Effacement Fin")
	(setq mod_c
		(getkword
			(strcat
				"\nMode de construction des éléments:"
				"\n[Reinit/CHarge/CReation/Effacement/Fin] < "
				mod_sc
				" >: "
			)
		)
	)
	(if (not mod_c) (setq mod_c mod_sc))
	(cond
		((= mod_c "Reinit")
			(prompt "\nLa mémorisation de tous les éléments construits sera perdu.")
			(initget "Oui Non")
			(if (eq (getkword "\nEtes vous sûr [Oui/Non]? < N >: ") "Oui")
				(progn
					(setq np nil nl nil nd nil nc nil nr nil nn nil
					      stk_pt nil stk_di nil stk_dr nil stk_cr nil stk_li nil stk_al nil
					)
					(prompt "\nReinitialisation effectuée pour un nouvel axe")
				)
				(prompt "\nReinitialisation non effectuée")
			)
		)
		((= mod_c "CHarge")
			(prompt "\nLa mémorisation de tous les éléments en cours sera perdu.")
			(initget "Oui Non")
			(if (eq (getkword "\nEtes vous sûr [Oui/Non]? < N >: ") "Oui")
				(progn
					(setq fc_mem (strcat (getvar "dwgprefix") (getvar "dwgname") ".CMP"))
					(if (findfile fc_mem)
						(progn
							(setq fc_mem (open fc_mem "r"))
							(setq np (read (read-line fc_mem)))
							(setq nl (read (read-line fc_mem)))
							(setq nd (read (read-line fc_mem)))
							(setq nc (read (read-line fc_mem)))
							(setq nr (read (read-line fc_mem)))
							(setq nn (read (read-line fc_mem)))
							(setq stk_pt (read (read-line fc_mem)))
							(setq stk_di (read (read-line fc_mem)))
							(setq stk_dr (read (read-line fc_mem)))
							(setq stk_cr (read (read-line fc_mem)))
							(setq stk_li (read (read-line fc_mem)))
							(setq stk_al (read (read-line fc_mem)))
							(close fc_mem)
							(prompt "\nRechargement de la dernière session effectuée")
						)
						(progn
							(setq np nil nl nil nd nil nc nil nr nil nn nil
							      stk_pt nil stk_di nil stk_dr nil stk_cr nil stk_li nil stk_al nil
							)
							(prompt "\nPas de session précédente à rappeler,Remize à zéro effectuée.")
						)
					)
				)
				(prompt "\nReinitialisation non effectuée")
			)
		)
		((= mod_c "CReation")
			(cr_ele)
		)
		((= mod_c "Effacement")
			(ef_ele)
		)
		(T
			(prompt "\nEcriture du fichier de commande")
			(if (or stk_pt stk_di stk_al)
				(cr_com)
				(prompt "\nAucun élément construit, écriture du fichier abandonné.")
			)
		)
	)
)
(redraw)
(if (= sv_ucs 0)
	(progn
		(command "._ucs" "_restore" "$_TEMPO_$")
		(command "._ucs" "_delete" "$_TEMPO_$")
	)
)
(setvar "blipmode" sv_blp)
(setvar "osmode" sv_osm)
(setq *error* olderr)
(setvar "cmdecho" 1)
(prin1)
)

Connexion

Creation d\'axe en lsp autocad pour Piste

Messages recommandés

zizouspawn

didier

bonuscad

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante