Exportation Autocad - Piste 5

philous2 · le 13 mars 2008

je cherche un applicatif AutoCAD qui permet de bénéficier de la souplesse d' AutoCAD pour faciliter mes tâches vers le logiciel Piste ( Piste 4 ou Piste 5 ) du SETRA. Cela me permettrait de mfaire mes axes sur Autocad et de récupérer sous forme par exemple de fichier txt les coordonnés de contruction (ligne , cercle, etc...),, gain important de temps et manipulaton beaucoup plus facile.

bonuscad · le 13 mars 2008

Un truc assez ancien, que je ne me sert plus, mais qui devrait encore fonctionner (je n'ai pas l'intention d'y retravailler dessus)

A défaut de trouver autre chose...

(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 ([b]<[/b]= (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]? [b]<[/b]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 ([b]<[/b]= (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 ([b]<[/b] 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 ([b]<[/b] 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][b]<[/b]"
			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 ([b]<[/b]= (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 ([b]<[/b]= (if nn (+ (* 2 (car nn)) (car nl)) (car nl)) 50)
				(progn
					(setq s_sel (entsel "\nChoisissez une ligne, un arc, un cercle ou [b]<[/b]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 ([b]<[/b]= (car nd) 50)
				(progn
					(initget "Existants")
					(setq mod_cr (getkword "\nDroite avec points [Existants]/[b]<[/b]RETURN pour selection ligne>: "))
					(cond
						((eq mod_cr "Existants")
							(cond
								((> (length np) 2)
									(setq cmpt 0)
									(while ([b]<[/b] 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 ([b]<[/b] (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 ([b]<[/b]= (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]? [b]<[/b]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 ([b]<[/b]= (car nc) 50)
				(progn
					(initget "Existants")
					(setq mod_cr (getkword "\nCercle avec points et distances [Existants]/[b]<[/b]RETURN pour selection cercle>: "))
					(cond
						((eq mod_cr "Existants")
							(cond
								((and (> (length np) 1) (> (length nl) 1))
									(setq cmpt 0)
									(while ([b]<[/b] cmpt 1)
										(displ np stk_pt "POInt" nil)
										(setq avec (choice "\nLibellé du point à utiliser ?: " np stk_pt "POInt" nil))
									)
									(while ([b]<[/b] 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 ([b]<[/b]= (length np) 1)
										(prompt "\nAucun point défini")
									)
									(if ([b]<[/b]= (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 ([b]<[/b]= (car np) 100)
										(progn
											(setq nl (cons (1+ (car nl)) nl))
											(if ([b]<[/b]= (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]? [b]<[/b]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 ([b]<[/b]= (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 ([b]<[/b] 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 ([b]<[/b] 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] [b]<[/b]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 ([b]<[/b] cmpt 1)
										(displ nc stk_cr "CERcle" nil)
										(setq avec (cons "CERcle" (choice "\nLibellé du 1er cercle à utiliser ?: " nc stk_cr "CERcle" nil)))
									)
									(while ([b]<[/b] 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] [b]<[/b]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]? [b]<[/b]DROite>: ") "CERcle")
										(progn
											(while ([b]<[/b] 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 ([b]<[/b] 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 ([b]<[/b] (length nd) 1)
										(prompt "\nAucune droite définie")
									)
									(if ([b]<[/b] (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[b]<[/b]-- 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] [b]<[/b]"
				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]? [b]<[/b]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]? [b]<[/b]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)
)

Après usage, il suffit de faire dans piste "lire fichier commande" et de sélectionner le fichier CAP créé pour retrouver tes éléments.

[Edité le 13/3/2008 par bonuscad]

philous2 · le 13 mars 2008

Ok j"essaierai demain et c'est quoi l'extention du fichier à lire ds piste !

Ca donne quoi comme interpretation les points de construction ou les points et les lignes, cercle

philous2 · le 13 mars 2008

ah oui j'oubliais c'est quoi le nom du lisp et de la commande d'entrée

lili2006 · le 13 mars 2008

Bonsoir à toutes et tous,

ah oui j'oubliais c'est quoi le nom du lisp

C'est piscom, il me semble,...

philous2 · le 14 mars 2008

bjr,

j'ai essayé ce matin ca ne marche pas bien au nivea transfert.

J'avais rentré ça au début "Ecriture du fichier de commande

[surligneur] POI PT1 256.3599 229.1926

DIS LG1 20

DIS LG2 20[/surligneur]CER CR1 PT1 LG1' m'étant trompé puisque cela ne donnait qui point en, réalité ds piste

"Point :

PT1 : X= 256.360 Y= 229.193

Distances :

NUL : D= 0.000

LG1 : D= 20.000

Cercle :

CR1 :XC= 256.360 YC= 229.193 RC= 20.000"

J'aui donc refait en mettant cela "Ecriture du fichier de commande

POI PT1 28.736 294.1454

POI PT2 357.0715 262.4818

POI PT3 347.4723 162.9436

POI PT4 437.6041 206.2596

POI PT5 523.8437 26.8125

DIS LG1 -100

DRO DR1 PT1 PT2

DRO DR2 PT4 PT5

CER CR1 PT3 LG1"

et je me retrouve tjrs avec

Point :

PT1 : X= 256.360 Y= 229.193

Distances :

NUL : D= 0.000

LG1 : D= 20.000

Cercle :

CR1 :XC= 256.360 YC= 229.193 RC= 20.000"

j'ai dionc un soucis en fait il ne me fait qu'un point.

Il ne transfert pas mes dernières donnés mlgré que je l'enregistre sous un autre fichier cap il y a un bug quelque part ou quelque chose que j'ai mal fait surement

bonuscad · le 14 mars 2008

La commande PISCOM mémorise les éléments saisis lors d'une précédente utilisation.

Ceux-ci sont donc toujours en mémoire tant que tu reste dans la session.

Ils peuvent être rechargés en mémoire pour une session ultérieure à l'aide de l'option "CHarge"

(un fichier d'extension CMP est créé automatiquement pour retrouver ces paramètres)

Donc si tu veux vider la mémoire pour être sur de recommencer au début, tu doit utiliser l'option "Reinit'

"Creation" est l'option pour créer de nouveaux éléments.

"Effacement" est l'option pour supprimer des éléments précédemment créés.

NB: Tu n'as pas forcément besoin de construire les points de définitions pour la création des éléments tel que DROite et CERcle, il te faut juste faire "Entrée" pour passer en mode sélection.

Les éléments nécessaires sont automatiquement créés.

L'option "Fin" permet l'écriture d'un fichier à l'extension "CAP" (Commande Axe Plan)

Dans piste il te faut passer par "Lire un fichier de commande" et lui désigner celui-ci.

Tu retrouveras tous tes éléments, et tu n'auras plus qu'a construire ton axe

PS:Jamais testé sous la version 5 de piste (je ne l'utilise plus)

Suivant la configuration du click-droit sous autocad tu peux utiliser la commande PISCOM sans toucher le clavier, tu retrouve les options dans le menu contextuel.

(valeur de SHORTCUTMENU à 11: valeur par défaut si non modifié)

ghis3 · le 21 avril 2008

Bonjour,

Vous pouvez également essayer AutoCAD PisteFinisher. Détail sur la page http://www.fastcao.com/?for=AutoCAD&r=Partagiciels&n=PisteFinisher&ver=1.00.

Veuillez m'excuser si ça fait Publicité. C'est une application commerciale. La démo ne fait pas plus de trois objets.

Nous-contacter pour d'autres souhaits et remarques.

Très cordialement les amis.

le 3 mars 2011

comment utiliser ce routine svp

Connexion

Exportation Autocad - Piste 5

Messages recommandés

philous2

Lien vers le commentaire

Partager sur d’autres sites

bonuscad

Lien vers le commentaire

Partager sur d’autres sites

philous2

Lien vers le commentaire

Partager sur d’autres sites

philous2

Lien vers le commentaire

Partager sur d’autres sites

lili2006

Lien vers le commentaire

Partager sur d’autres sites

philous2

Lien vers le commentaire

Partager sur d’autres sites

bonuscad

Lien vers le commentaire

Partager sur d’autres sites

ghis3

Lien vers le commentaire

Partager sur d’autres sites

Invité ghouribachir85

Lien vers le commentaire

Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante