Coupe sur TN

xav083 · le 8 octobre 2007

Une coupe sur un terrain naturel (Voir littérature)

lovecraft · le 8 octobre 2007

si tu n'as qu'autocad je te suggere de tranformer ton TN face3D en solide, "en faisant une extrusion de ton TN d'1mm apres avec autocad tu pourras effectuer un coupe.

@plus

bonuscad · le 10 octobre 2007

Bonjour,

J'ai essayé d'adapter plusieurs routines que j'avais faites.

Le code est du coup un peu brouillon, mais je vous le livre pour un premier essai, en espérant que le copié-collé fonctionnera.

Il faut dans le dessin des 3d faces et une ligne représentant la coupe à effectuer. (l'axe de la coupe sera au milieu de la ligne sélectionnée)

La routine effectue alors la coupe dans un calque précis et cote celui-ci comme un profil en travers.

Les commandes dispo sont COUPE_TN et CHOISIR_COUPE

"Choisir_coupe" permet de recoter la coupe TN si on a modifié la polyligne de TN verte.

On peut aussi dessiner d'autres polylignes (rouge, cyan, bleu) dans la coupe effectuée, et lors de la relance de "Choisir_coupe", recote toute les lwpolylignes et réadapte le cartouche.

((lambda (/)
		(if (null (tblsearch "STYLE" "COT_TRF"))
			(command "_.style" "$TRF_COT" "MONOTXT" "0.0" "0.9" "0.0" "_N" "_N" "_N")
		)
		(if (null (tblsearch "LTYPE" "AXES2"))
			(progn
				(command "_.linetype" "_load" "AXES2" "ACADISO.LIN" "")
				(setvar "ltscale" 1.0)
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_ALTI"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_ALTI") (8 . "0") (70 . 66) (10 0.0 0.0 0.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.2) (1 . "") (3 . "Altitude du point") (2 . "ALTI") (70 . 0) (50 . 1.570796326794896) (7 . "$TRF_COT") (72 . 2)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_DIST"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_DIST") (8 . "0") (70 . 66) (10 0.0 0.0 0.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.2) (1 . "") (3 . "Distance du point") (2 . "DIST") (70 . 0) (50 . 1.570796326794896) (7 . "$TRF_COT") (72 . 2)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_TITRE_CARTRAV"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_TITRE_CARTRAV") (8 . "0") (70 . 66) (10 0.0 0.0 0.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 -6.0 0.0 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 -6.0 4.0 0.0) (40 . 0.3) (1 . "PROFIL No") (7 . "$TRF_COT") (210 0.0 0.0 1.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 -3.1 4.0 0.0) (40 . 0.3) (1 . "1") (3 . "Numéro du profil ?:") (2 . "NO-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 -6.0 2.5 0.0) (40 . 0.3) (1 . "ABSCISSE =") (7 . "$TRF_COT") (210 0.0 0.0 1.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 -2.8 2.5 0.0) (40 . 0.3) (1 . "0.00") (3 . "Abscisse du profil ?:") (2 . "ABS-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 -6.0 2.0 0.0) (40 . 0.3) (1 . "ECH = 1/") (7 . "$TRF_COT") (210 0.0 0.0 1.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 -3.55 2.0 0.0) (40 . 0.3) (1 . "100") (3 . "Echelle du profil ?:") (2 . "ECH-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 -6.0 1.0 0.0) (40 . 0.3) (1 . "PC =") (7 . "$TRF_COT") (210 0.0 0.0 1.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 -4.5 1.0 0.0) (40 . 0.3) (1 . "100") (3 . "Plan de comparaison du profil ?:") (2 . "PC-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_CARTRAV"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_CARTRAV") (8 . "0") (70 . 66) (10 0.0 0.0 0.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 -6.0 0.0 0.0) (11 -6.0 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 -6.0 -2.75 0.0) (11 0.0 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 -0.35 0.0 0.0) (11 -0.35 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 -0.35 -1.375 0.0) (11 0.0 -1.375 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "DISTANCES") (7 . "$TRF_COT") (72 . 2) (11 -0.5 -0.6875 0.0) (210 0.0 0.0 1.0) (73 . 2)))
				(entmake '((0 . "TEXT") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "COTES") (7 . "$TRF_COT") (72 . 2) (11 -0.5 -2.0625 0.0) (210 0.0 0.0 1.0) (73 . 2)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "TERRAIN") (3 . "Quel ligne ?:") (2 . "INTITULE") (70 . 0) (7 . "$TRF_COT") (11 -5.7 -1.375 0.0) (210 0.0 0.0 0.0) (74 . 2)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_STRECHCART"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_STRECHCART") (8 . "0") (70 . 64) (10 0.0 0.0 0.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 1.0 0.0 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 1.0 0.0 0.0) (11 1.0 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 1.0 -2.75 0.0) (11 0.0 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 0.0 -1.375 0.0) (11 1.0 -1.375 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_TIRET-COT"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_TIRET-COT") (8 . "0") (70 . 64) (10 0.0 0.0 0.0)))
				(entmake '((0 . "LINE") (8 . "0") (62 . 0) (10 0.0 -0.05 0.0) (11 0.0 0.05 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_DRAPAX"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_DRAPAX") (8 . "0") (70 . 64) (10 0.0 0.0 0.0)))
				(entmake
					(list
						'(0 . "LINE") '(8 . "0") '(62 . 0)
						(cons 10 (list (* (sin (/ pi 4)) -0.25) (* (cos (/ pi 4)) -0.25) 0.0))
						(cons 11 (list (* (sin (/ pi 4)) 0.5) (* (cos (/ pi 4)) 0.5) 0.0))
						'(210 0.0 0.0 1.0)
					)
				)
				(entmake
					(list
						'(0 . "LINE") '(8 . "0") '(62 . 0)
						(cons 10 (list (* (sin (/ pi 4)) 0.5) (* (cos (/ pi 4)) 0.5) 0.0))
						(cons 11 (list (* (sin (/ pi 4)) 0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0))
						'(210 0.0 0.0 1.0)
					)
				)
				(entmake
					(list
						'(0 . "LINE") '(8 . "0") '(62 . 0)
						(cons 10 (list (* (sin (/ pi 4)) 0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0))
						(cons 11 (list (+ (* (sin (/ pi 4)) -0.075) (* (sin (/ pi 4)) 0.5)) (+ (* (cos (/ pi 4)) 0.075) (- (* (cos (/ pi 4)) 0.5) 0.25)) 0.0))
						'(210 0.0 0.0 1.0)
					)
				)
				(entmake
					(list
						'(0 . "LINE") '(8 . "0") '(62 . 0)
						(cons 10 (list (* (sin (/ pi 4)) 0.25) (* (cos (/ pi 4)) -0.25) 0.0))
						(cons 11 (list (* (sin (/ pi 4)) -0.5) (* (cos (/ pi 4)) 0.5) 0.0))
						'(210 0.0 0.0 1.0)
					)
				)
				(entmake
					(list
						'(0 . "LINE") '(8 . "0") '(62 . 0)
						(cons 10 (list (* (sin (/ pi 4)) -0.5) (* (cos (/ pi 4)) 0.5) 0.0))
						(cons 11 (list (* (sin (/ pi 4)) -0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0))
						'(210 0.0 0.0 1.0)
					)
				)
				(entmake
					(list
						'(0 . "LINE") '(8 . "0") '(62 . 0)
						(cons 10 (list (* (sin (/ pi 4)) -0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0))
						(cons 11 (list (+ (* (sin (/ pi 4)) 0.075) (* (sin (/ pi 4)) -0.5)) (+ (* (cos (/ pi 4)) 0.075) (- (* (cos (/ pi 4)) 0.5) 0.25)) 0.0))
						'(210 0.0 0.0 1.0)
					)
				)
				(entmake '((0 . "ENDBLK")))
			)
		)
))
(defun eob (arg / )
   (/ (* arg echll) 100.0)
)
(defun matrix (pt id / t_x t_y t_z t_v t_zo e_x e_y e_z nw_x nw_y nw_z)
(setq
	t_x (trans '(1 0 0) 0 1 T)
	t_y (trans '(0 1 0) 0 1 T)
	t_z (trans '(0 0 1) 0 1 T)
	t_v (trans '(0 0 0) 1 0)
	t_zo (trans '(0 0 0) 0 1)
)
(setq dxf_210 (list (caddr t_x) (caddr t_y) (caddr t_z)))
(cond
	((= id "2D")
		(setq e_x (car t_zo) e_y (cadr t_zo) e_z (caddr t_zo))
		(setq dxf_10 (list 0.0 0.0 (- e_z)))
		(setq nw_x (+ (- (car t_zo)) (car pt)))
		(setq nw_y (+ (- (cadr t_zo)) (cadr pt)))
		(setq nw_z (+ (- (caddr t_zo)) (caddr pt)))
	)
	((= id "3D")
		(setq nw_x
			(+
				(* (car pt) (car t_x))
				(* (cadr pt) (cadr t_x))
				(* (caddr pt) (caddr t_x))
				(car t_v)
			)
		)
		(setq nw_y
			(+
				(* (car pt) (car t_y))
				(* (cadr pt) (cadr t_y))
				(* (caddr pt) (caddr t_y))
				(cadr t_v)
			)
		)
		(setq nw_z
			(+
				(* (car pt) (car t_z))
				(* (cadr pt) (cadr t_z))
				(* (caddr pt) (caddr t_z))
				(caddr t_v)
			)
		)
	)
)
(setq nw_pt (list nw_x nw_y nw_z))
)
(defun writ_cot (ent_po col_po / ptprc pdtx dxf_lst)
(if (= col_po 3)
	(progn
		(entmake
			(list
				(cons 0 "INSERT") (cons 8 nouv) (cons 62 1) (cons 2 "TRF_DRAPAX") (cons 10 (matrix (list 0.0 (+ 1.5 high_z) 0.0) "2D")) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
			)
		)
		(entmake
			(list
				(cons 0 "LINE")
				(cons 8 nouv)
				(cons 62 1)
				(cons 6 "AXES2")
				(cons 10 (trans (list 0.0 (+ 1.5 high_z) 0.0) 1 0))
				(cons 11 (trans (list 0.0 pc 0.0) 1 0))
				(cons 210 dxf_210)
			)
		)
		(setq dxf_lst (entget ent_po))
	)
	(setq dxf_lst (reverse (entget ent_po)))
)
(foreach pdtx (reverse (mapcar '(lambda (z) (trans (trans z ent_po 0) 0 1)) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) dxf_lst))))
	(cond
		((/= ptprc ())
			(if
				(or
					([b]<[/b] (- (car pdtx) (car ptprc)) (eob 0.25))
					([b]<[/b] (car pdtx) (car ptprc))
				)
				(setq ptprc (cons (+ (car ptprc) (eob 0.25)) (list (cadr pdtx))))
				(setq ptprc pdtx)
			)
		)
		(T (setq ptprc pdtx))
	)
	(entmake
		(list
			(cons 0 "INSERT") (cons 8 nouv) (cons 62 col_po) (cons 2 "TRF_TIRET-COT")
			(cons 10 (matrix pdtx "2D")) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
		)
	)
	(entmake)
	(entmake
		(list
			(cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_DIST")
			(cons 10 (matrix (list (car ptprc) (- pc (eob 0.05)) 0.0) "2D")) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
		)
	)
	(entmake
		(list
			(cons 0 "ATTRIB") (cons 8 "0")
			(cons 10 (matrix (list (car ptprc) (- pc (eob 0.05)) 0.0) "2D")) (cons 40 (eob 0.2))
			(cons 1 (rtos (car pdtx) 2 2)) (cons 2 "DIST") (cons 70 0) (cons 50 (/ pi 2)) (cons 7 "$TRF_COT")
			(cons 11 (matrix (list (car ptprc) (- pc (eob 0.05)) 0.0) "2D")) (cons 72 2) (cons 210 dxf_210) (cons 74 0)
		)
	)
	(entmake (list '(0 . "SEQEND") (cons 8 nouv)))
	(entmake)
	(entmake
		(list
			(cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_ALTI")
			(cons 10 (matrix (list (car ptprc) (- pc (eob 1.425)) 0.0) "2D")) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
		)
	)
	(entmake
		(list
			(cons 0 "ATTRIB") (cons 8 "0")
			(cons 10 (matrix (list (car ptprc) (- pc (eob 1.425)) 0.0) "2D")) (cons 40 (eob 0.2))
			(cons 1 (rtos (cadr pdtx) 2 2)) (cons 2 "ALTI") (cons 70 0) (cons 50 (/ pi 2)) (cons 7 "$TRF_COT")
			(cons 11 (matrix (list (car ptprc) (- pc (eob 1.425)) 0.0) "2D")) (cons 72 2) (cons 210 dxf_210) (cons 74 0)
		)
	)
	(entmake (list '(0 . "SEQEND") (cons 8 nouv)))
)
)
(defun do_poly ( col / js_tmp ent_po ttr_ca)
(setq js_tmp (ssget "X" (list '(0 . "LWPOLYLINE") (cons 62 col) (cons 8 nouv))))
(cond
	((and js_tmp (eq (sslength js_tmp) 1))
		(setq ent_po (ssname js_tmp 0))
		(setq ttr_ca
			(cond
				((eq col 1) "PROJET")
				((eq col 4) "ASSISE")
				((eq col 6) "FORME")
				((eq col 5) "BASE")
			)
		)
			(setq pc (- pc (eob 2.75)))
		(setq
			pt_ins (trans (list (car (last lst_som)) pc 0.0) 1 0)
			pt_ins (matrix (trans pt_ins 0 1) "2D")
			pt_coi (trans (list (caar lst_som) pc 0.0) 1 0)
		)
		(entmake)
		(entmake
			(list
				(cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_CARTRAV")
				(cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
			)
		)
		(entmake
			(list
				(cons 0 "ATTRIB") (cons 8 "0")
				(cons 10 pt_ins) (cons 40 (eob 0.3)) (cons 1 ttr_ca) (cons 2 "INTITULE") (cons 70 0) (cons 7 "$TRF_COT")
				(cons 11 (list (+ (car pt_ins ) (eob -5.7)) (+ (cadr pt_ins) (eob -1.375)) (caddr pt_ins))) (cons 210 dxf_210) (cons 74 2)
			)
		)
		(entmake (list '(0 . "SEQEND") (cons 8 nouv)))
		(entmake
			(list
				(cons 0 "INSERT") (cons 8 nouv) (cons 66 0) (cons 2 "TRF_STRECHCART")
				(cons 10 pt_ins) (cons 41 (+ (distance (list (caar lst_som) pc 0.0) (list (car (last lst_som)) pc 0.0)) (eob 0.35))) (cons 42 (eob 1))
				(cons 43 (eob 1)) (cons 210 dxf_210)
			)
		)
		(writ_cot ent_po col)
		(setq js_tmp nil)
	)
)
)
(defun c:choisir_coupe ( / echll nouv n_pr js cod js_tmp ent lst_som ent_po pc high_z pt_ins pt_coi dxf_210)
(if (zerop (getvar "useri1"))
	(setvar "useri1" 100)
)
(initget 6)
(setq echll (getint (strcat "\nEntrez l'echelle du profil[b]<[/b]" (itoa (getvar "useri1")) ">: ")))
(if (not echll) (setq echll (getvar "useri1")))
(setvar "useri1" echll)
(setq nouv (getvar "clayer") n_pr (atoi (substr (getvar "clayer") 12)) a_curv 0.0)
(command "._layer" "_thaw" nouv "_set" nouv "_freeze" "*" "_off" "*" "_on" nouv "")
(command "_ucs" "_restore" nouv)
(command "_.plan" "")
(setq js
	(ssget "X"
		(list
			'(-4 . "[b]<[/b]OR")
				'(-4 . "[b]<[/b]AND")
					'(0 . "LINE") '(62 . 3) (cons 8 nouv)
				'(-4 . "AND>")
				'(-4 . "[b]<[/b]AND")
					'(0 . "INSERT") '(2 . "TRF_TITRE_CARTRAV") (cons 8 nouv)
				'(-4 . "AND>")
				'(-4 . "[b]<[/b]AND")
					'(0 . "INSERT") '(2 . "TRF_CARTRAV") (cons 8 nouv)
				'(-4 . "AND>")
				'(-4 . "[b]<[/b]AND")
					'(0 . "INSERT") '(2 . "TRF_STRECHCART") (cons 8 nouv)
				'(-4 . "AND>")
				'(-4 . "[b]<[/b]AND")
					'(0 . "INSERT") '(2 . "TRF_DIST") (cons 8 nouv)
				'(-4 . "AND>")
				'(-4 . "[b]<[/b]AND")
					'(0 . "INSERT") '(2 . "TRF_ALTI") (cons 8 nouv)
				'(-4 . "AND>")
				'(-4 . "[b]<[/b]AND")
					'(0 . "INSERT") '(2 . "TRF_TIRET-COT") (cons 8 nouv)
				'(-4 . "AND>")
				'(-4 . "[b]<[/b]AND")
					'(0 . "INSERT") '(2 . "TRF_DRAPAX") (cons 8 nouv)
				'(-4 . "AND>")
			'(-4 . "OR>")
		)
	)
)
(cond (js (command "_.erase" "_previous" "")))
(setq js nil)
(initget "Oui Non")
(setq cod (getkword "\nMettre le profil a jour ? [Oui/Non] [b]<[/b]N>: "))
(if (eq cod ()) (setq cod "Non"))
(cond
	((eq cod "Oui")
		(prompt "\nMise à jour en cours...")
		(if (null (tblsearch "STYLE" "COT_TRF"))
			(command "_.style" "$TRF_COT" "MONOTXT" "0.0" "0.9" "0.0" "_N" "_N" "_N")
		)
		(if (null (tblsearch "LTYPE" "AXES2"))
			(progn
				(command "_.linetype" "_load" "AXES2" "ACADISO.LIN" "")
				(setvar "ltscale" 1.0)
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_ALTI"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_ALTI") (8 . "0") (70 . 66) (10 0.0 0.0 0.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.2) (1 . "") (3 . "Altitude du point") (2 . "ALTI") (70 . 0) (50 . 1.570796326794896) (7 . "$TRF_COT") (72 . 2)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_DIST"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_DIST") (8 . "0") (70 . 66) (10 0.0 0.0 0.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.2) (1 . "") (3 . "Distance du point") (2 . "DIST") (70 . 0) (50 . 1.570796326794896) (7 . "$TRF_COT") (72 . 2)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_TITRE_CARTRAV"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_TITRE_CARTRAV") (8 . "0") (70 . 66) (10 0.0 0.0 0.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 -6.0 0.0 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 -6.0 4.0 0.0) (40 . 0.3) (1 . "PROFIL No") (7 . "$TRF_COT") (210 0.0 0.0 1.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 -3.1 4.0 0.0) (40 . 0.3) (1 . "1") (3 . "Numéro du profil ?:") (2 . "NO-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 -6.0 2.5 0.0) (40 . 0.3) (1 . "ABSCISSE =") (7 . "$TRF_COT") (210 0.0 0.0 1.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 -2.8 2.5 0.0) (40 . 0.3) (1 . "0.00") (3 . "Abscisse du profil ?:") (2 . "ABS-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 -6.0 2.0 0.0) (40 . 0.3) (1 . "ECH = 1/") (7 . "$TRF_COT") (210 0.0 0.0 1.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 -3.55 2.0 0.0) (40 . 0.3) (1 . "100") (3 . "Echelle du profil ?:") (2 . "ECH-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 -6.0 1.0 0.0) (40 . 0.3) (1 . "PC =") (7 . "$TRF_COT") (210 0.0 0.0 1.0)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 -4.5 1.0 0.0) (40 . 0.3) (1 . "100") (3 . "Plan de comparaison du profil ?:") (2 . "PC-PR") (70 . 0) (7 . "$TRF_COT") (210 0.0 0.0 0.0)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_CARTRAV"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_CARTRAV") (8 . "0") (70 . 66) (10 0.0 0.0 0.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 -6.0 0.0 0.0) (11 -6.0 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 -6.0 -2.75 0.0) (11 0.0 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 -0.35 0.0 0.0) (11 -0.35 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 -0.35 -1.375 0.0) (11 0.0 -1.375 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "TEXT") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "DISTANCES") (7 . "$TRF_COT") (72 . 2) (11 -0.5 -0.6875 0.0) (210 0.0 0.0 1.0) (73 . 2)))
				(entmake '((0 . "TEXT") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "COTES") (7 . "$TRF_COT") (72 . 2) (11 -0.5 -2.0625 0.0) (210 0.0 0.0 1.0) (73 . 2)))
				(entmake '((0 . "ATTDEF") (8 . "0") (10 0.0 0.0 0.0) (40 . 0.3) (1 . "TERRAIN") (3 . "Quel ligne ?:") (2 . "INTITULE") (70 . 0) (7 . "$TRF_COT") (11 -5.7 -1.375 0.0) (210 0.0 0.0 0.0) (74 . 2)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_STRECHCART"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_STRECHCART") (8 . "0") (70 . 64) (10 0.0 0.0 0.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 0.0 0.0 0.0) (11 1.0 0.0 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 1.0 0.0 0.0) (11 1.0 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 1.0 -2.75 0.0) (11 0.0 -2.75 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "LINE") (8 . "0") (10 0.0 -1.375 0.0) (11 1.0 -1.375 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_TIRET-COT"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_TIRET-COT") (8 . "0") (70 . 64) (10 0.0 0.0 0.0)))
				(entmake '((0 . "LINE") (8 . "0") (62 . 0) (10 0.0 -0.05 0.0) (11 0.0 0.05 0.0) (210 0.0 0.0 1.0)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(if (null (tblsearch "BLOCK" "TRF_DRAPAX"))
			(progn
				(entmake)
				(entmake '((0 . "BLOCK") (2 . "TRF_DRAPAX") (8 . "0") (70 . 64) (10 0.0 0.0 0.0)))
				(entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) -0.25) (* (cos (/ pi 4)) -0.25) 0.0)) (cons 11 (list (* (sin (/ pi 4)) 0.5) (* (cos (/ pi 4)) 0.5) 0.0)) '(210 0.0 0.0 1.0)))
				(entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) 0.5) (* (cos (/ pi 4)) 0.5) 0.0)) (cons 11 (list (* (sin (/ pi 4)) 0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) '(210 0.0 0.0 1.0)))
				(entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) 0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) (cons 11 (list (+ (* (sin (/ pi 4)) -0.075) (* (sin (/ pi 4)) 0.5)) (+ (* (cos (/ pi 4)) 0.075) (- (* (cos (/ pi 4)) 0.5) 0.25)) 0.0)) '(210 0.0 0.0 1.0)))
				(entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) 0.25) (* (cos (/ pi 4)) -0.25) 0.0)) (cons 11 (list (* (sin (/ pi 4)) -0.5) (* (cos (/ pi 4)) 0.5) 0.0)) '(210 0.0 0.0 1.0)))
				(entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) -0.5) (* (cos (/ pi 4)) 0.5) 0.0)) (cons 11 (list (* (sin (/ pi 4)) -0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) '(210 0.0 0.0 1.0)))
				(entmake (list '(0 . "LINE") '(8 . "0") '(62 . 0) (cons 10 (list (* (sin (/ pi 4)) -0.5) (- (* (cos (/ pi 4)) 0.5) 0.25) 0.0)) (cons 11 (list (+ (* (sin (/ pi 4)) 0.075) (* (sin (/ pi 4)) -0.5)) (+ (* (cos (/ pi 4)) 0.075) (- (* (cos (/ pi 4)) 0.5) 0.25)) 0.0)) '(210 0.0 0.0 1.0)))
				(entmake '((0 . "ENDBLK")))
			)
		)
		(setq js_tmp (ssget "X" (list '(0 . "LWPOLYLINE") '(62 . 3) (cons 8 nouv))))
		(cond
			((and js_tmp (eq (sslength js_tmp) 1))
				(setq ent (ssname js_tmp 0) lst_som '() ent_po ent)
				(setq lst_som (mapcar '(lambda (z) (trans (trans z ent 0) 0 1)) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))))
				(setq pc (cadar lst_som) high_z pc)
				(foreach n lst_som (setq pc (min pc (cadr n))))
				(foreach n lst_som (setq high_z (max high_z (cadr n))))
				(setq pc (* (/ (fix pc) 10) 10))
				(setq
					pt_ins (trans (list (car (last lst_som)) pc 0.0) 1 0)
					pt_coi (trans (list (caar lst_som) pc 0.0) 1 0)
				)
				(matrix '(0 0 0) "2D")
				(entmake
					(list
						(cons 0 "LINE")
						(cons 8 nouv)
						(cons 62 3)
						(cons 10 (trans (list (car (last lst_som)) (cadr (last lst_som)) 0.0) 1 0))
						(cons 11 pt_ins)
						(cons 210 dxf_210)
					)
				)
				(entmake
					(list
						(cons 0 "LINE")
						(cons 8 nouv)
						(cons 62 3)
						(cons 10 (trans (list (caar lst_som) (cadar lst_som) 0.0) 1 0))
						(cons 11 pt_coi)
						(cons 210 dxf_210)
					)
				)
				(setq pt_ins (matrix (trans pt_ins 0 1) "2D"))
				(entmake)
				(entmake
					(list
						(cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_TITRE_CARTRAV")
						(cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
					)
				)
				(entmake
					(list
						(cons 0 "ATTRIB") (cons 8 "0")
						(cons 10 (list (+ (car pt_ins ) (eob -3.1)) (+ (cadr pt_ins) (eob 4.0)) (caddr pt_ins)))
						(cons 40 (eob 0.3)) (cons 1 (itoa n_pr)) (cons 2 "NO-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210)
					)
				)
				(entmake
					(list
						(cons 0 "ATTRIB") (cons 8 "0")
						(cons 10 (list (+ (car pt_ins ) (eob -2.8)) (+ (cadr pt_ins) (eob 2.5)) (caddr pt_ins)))
						(cons 40 (eob 0.3)) (cons 1 (rtos a_curv 2 2)) (cons 2 "ABS-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210)
					)
				)
				(entmake
					(list
						(cons 0 "ATTRIB") (cons 8 "0")
						(cons 10 (list (+ (car pt_ins ) (eob -3.7)) (+ (cadr pt_ins) (eob 2.0)) (caddr pt_ins)))
						(cons 40 (eob 0.3)) (cons 1 (itoa echll)) (cons 2 "ECH-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210)
					)
				)
				(entmake
					(list
						(cons 0 "ATTRIB") (cons 8 "0")
						(cons 10 (list (+ (car pt_ins ) (eob -4.5)) (+ (cadr pt_ins) (eob 1.0)) (caddr pt_ins)))
						(cons 40 (eob 0.3)) (cons 1 (itoa pc)) (cons 2 "PC-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210)
					)
				)
				(entmake (list '(0 . "SEQEND") (cons 8 nouv)))
				(entmake)
				(entmake
					(list
						(cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_CARTRAV")
						(cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
					)
				)
				(entmake
					(list
						(cons 0 "ATTRIB") (cons 8 "0") (cons 10 pt_ins) (cons 40 (eob 0.3))
						(cons 1 "TERRAIN") (cons 2 "INTITULE") (cons 70 0) (cons 7 "$TRF_COT")
						(cons 11 (list (+ (car pt_ins ) (eob -5.7)) (+ (cadr pt_ins) (eob -1.375)) (caddr pt_ins))) (cons 210 dxf_210) (cons 74 2)
					)
				)
				(entmake (list '(0 . "SEQEND") (cons 8 nouv)))
				(entmake
					(list
						(cons 0 "INSERT") (cons 8 nouv) (cons 66 0) (cons 2 "TRF_STRECHCART") (cons 10 pt_ins)
						(cons 41 (+ (distance (list (caar lst_som) pc 0.0) (list (car (last lst_som)) pc 0.0)) (eob 0.35)))
						(cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
					)
				)
				(writ_cot ent_po 3)
				(setq js_tmp nil)
				(foreach n '(1 4 6 5)
					(do_poly n)
				)
			)
		)
	)
)
(command "_.zoom" "_extent")
)
(defun c:coupe_tn ( / js_line dxf_line p1 p2 all_pt js n lst_px dxf_ent lst_pt px new_lst l el pt_all nouv n_pr echll a_curv ent lst_som ent_po pc high_z pt_ins pt_coi dxf_210)
(setq js_line (ssget "_+.:E:S" '((0 . "LINE"))))
(cond
	(js_line
		(setvar "cmdecho" 1)
		(setq
			dxf_line (entget (ssname js_line 0))
			p1 (list (cadr (assoc 10 dxf_line)) (caddr (assoc 10 dxf_line)))
			p2 (list (cadr (assoc 11 dxf_line)) (caddr (assoc 11 dxf_line)))
			all_pt nil
		)
		(command "_.zoom" "_window" p1 p2)
		(setq
			js (ssget "_F" (list p1 p2) '((0 . "3DFACE")))
			n -1
			lst_px nil
		)
		(cond
			(js
				(repeat (sslength js)
					(setq
						dxf_ent (entget (ssname js (setq n (1+ n))))
						lst_pt
						(list
							(cdr (assoc 10 dxf_ent))
							(cdr (assoc 11 dxf_ent))
							(cdr (assoc 12 dxf_ent))
							(cdr (assoc 13 dxf_ent))
						)
					)
					(if (equal (caddr lst_pt) (cadddr lst_pt))
						(setq lst_pt (list (car lst_pt) (cadr lst_pt) (caddr lst_pt) (car lst_pt)))
						(setq lst_pt (append lst_pt (list (car lst_pt))))
					)
					(while (cdr lst_pt)
						(setq px (inters p1 p2 (car lst_pt) (cadr lst_pt) T))
						(if px
							(progn
								(setq px (inters (list (car px) (cadr px) 0.0) (list (car px) (cadr px) 100.0) (car lst_pt) (cadr lst_pt) nil))
								(if (and px (not (member px lst_px)))
									(setq lst_px (cons px lst_px))
								)
							)
						)
						(setq lst_pt (cdr lst_pt))
					)
				)
				(if lst_px
					(progn
						(setq new_lst nil)
						(while lst_px
							(setq l (mapcar '(lambda (x) (distance x p1)) lst_px))
							(setq el (nth (- (length lst_px) (length (member (apply 'min l) l))) lst_px))
							(setq
								lst_px (vl-remove el lst_px)
								new_lst (cons el new_lst)
							)
						)
						(setq pt_all (append (list (cadr all_pt)) new_lst pt_all))
					)
					(setq pt_all (append (list (cadr all_pt)) pt_all))
				)
			)
		)
		(setq all_pt (cdr all_pt))
		(setq nouv (strcat "TRF_PROFIL-" (itoa (setq n_pr (getint "\nNuméro du profil: ")))))
		(if (zerop (getvar "useri1"))
			(setvar "useri1" 100)
		)
		(initget 6)
		(setq echll (getint (strcat "\nEntrez l'echelle du profil[b]<[/b]" (itoa (getvar "useri1")) ">: ")))
		(if (not echll) (setq echll (getvar "useri1")))
		(setvar "useri1" echll)
		(setq a_curv (getdist "\nDistance cumulée du profil: "))
		(setvar "expert" 5)
		(command "_.ucs" "_world")
		(command "_.ucs" "_3point" ".xy" "_none" (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5)) 0.0 ".xy" "_none" p2 0.0 ".xy" "_none" (mapcar '* (mapcar '+ p1 p2) '(0.5 0.5)) 1000.0)
		(command "_.ucs" "_save" nouv)
		(command "_.plan" "")
		(command "._layer" "_make" nouv "_thaw" nouv "_set" nouv "_freeze" "*" "_off" "*" "_on" nouv "")
		(setvar "cecolor" "3")
		(command "_.pline")
		(foreach el (cdr pt_all) (command "_none" (trans el 0 1)))
		(command "")
		(setq ent (entlast) lst_som '() ent_po ent)
		(setvar "cecolor" "256")
		(entdel (cdar dxf_line))
		(setq lst_som (mapcar '(lambda (z) (trans (trans z ent 0) 0 1)) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent)))))
		(setq pc (cadar lst_som) high_z pc)
		(foreach n lst_som (setq pc (min pc (cadr n))))
		(foreach n lst_som (setq high_z (max high_z (cadr n))))
		(setq pc (* (/ (fix pc) 10) 10))
		(setq
			pt_ins (trans (list (car (last lst_som)) pc 0.0) 1 0)
			pt_coi (trans (list (caar lst_som) pc 0.0) 1 0)
		)
		(matrix '(0 0 0) "2D")
		(entmake
			(list
				(cons 0 "LINE")
				(cons 8 nouv)
				(cons 62 3)
				(cons 10 (trans (list (car (last lst_som)) (cadr (last lst_som)) 0.0) 1 0))
				(cons 11 pt_ins)
				(cons 210 dxf_210)
			)
		)
		(entmake
			(list
				(cons 0 "LINE")
				(cons 8 nouv)
				(cons 62 3)
				(cons 10 (trans (list (caar lst_som) (cadar lst_som) 0.0) 1 0))
				(cons 11 pt_coi)
				(cons 210 dxf_210)
			)
		)
		(setq pt_ins (matrix (trans pt_ins 0 1) "2D"))
		(entmake)
		(entmake
			(list
				(cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_TITRE_CARTRAV")
				(cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
			)
		)
		(entmake
			(list
				(cons 0 "ATTRIB") (cons 8 "0")
				(cons 10 (list (+ (car pt_ins ) (eob -3.1)) (+ (cadr pt_ins) (eob 4.0)) (caddr pt_ins))) (cons 40 (eob 0.3))
				(cons 1 (itoa n_pr)) (cons 2 "NO-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210)
			)
		)
		(entmake
			(list
				(cons 0 "ATTRIB") (cons 8 "0")
				(cons 10 (list (+ (car pt_ins ) (eob -2.8)) (+ (cadr pt_ins) (eob 2.5)) (caddr pt_ins))) (cons 40 (eob 0.3))
				(cons 1 (rtos a_curv 2 2)) (cons 2 "ABS-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210)
			)
		)
		(entmake
			(list
				(cons 0 "ATTRIB") (cons 8 "0")
				(cons 10 (list (+ (car pt_ins ) (eob -3.7)) (+ (cadr pt_ins) (eob 2.0)) (caddr pt_ins))) (cons 40 (eob 0.3))
				(cons 1 (itoa echll)) (cons 2 "ECH-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210)
			)
		)
		(entmake
			(list
				(cons 0 "ATTRIB") (cons 8 "0")
				(cons 10 (list (+ (car pt_ins ) (eob -4.5)) (+ (cadr pt_ins) (eob 1.0)) (caddr pt_ins))) (cons 40 (eob 0.3))
				(cons 1 (itoa pc)) (cons 2 "PC-PR") (cons 70 0) (cons 7 "$TRF_COT") (cons 210 dxf_210)
			)
		)
		(entmake (list '(0 . "SEQEND") (cons 8 nouv)))
		(entmake)
		(entmake
			(list
				(cons 0 "INSERT") (cons 8 nouv) (cons 66 1) (cons 2 "TRF_CARTRAV")
				(cons 10 pt_ins) (cons 41 (eob 1)) (cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
			)
		)
		(entmake
			(list
				(cons 0 "ATTRIB") (cons 8 "0") (cons 10 pt_ins) (cons 40 (eob 0.3))
				(cons 1 "TERRAIN") (cons 2 "INTITULE") (cons 70 0) (cons 7 "$TRF_COT")
				(cons 11 (list (+ (car pt_ins ) (eob -5.7)) (+ (cadr pt_ins) (eob -1.375)) (caddr pt_ins))) (cons 210 dxf_210) (cons 74 2)
			)
		)
		(entmake (list '(0 . "SEQEND") (cons 8 nouv)))
		(entmake
			(list
				(cons 0 "INSERT") (cons 8 nouv) (cons 66 0) (cons 2 "TRF_STRECHCART")
				(cons 10 pt_ins) (cons 41 (+ (distance (list (caar lst_som) pc 0.0) (list (car (last lst_som)) pc 0.0)) (eob 0.35)))
				(cons 42 (eob 1)) (cons 43 (eob 1)) (cons 210 dxf_210)
			)
		)
		(writ_cot ent_po 3)
		(foreach n '(1 4 6 5)
			(do_poly n)
		)
	)
)
)

lili2006 · le 10 octobre 2007

Bonjour à toutes et tous,

Avec bonuscad, Covadis et Mensura sont en danger,....

Je n'ai pas eu encore le temps de tester mais cet outil, pour ceux qui n'ont que AutoCAD, sera un bienfait.

Encore bravo pour ce travail.

bonuscad · le 10 octobre 2007

Le fichier donné par lovecraft dans le sujet Challenge11 , se prête bien pour faire un essai.

Avec bonuscad, Covadis et Mensura sont en danger,....

:o

concurrencer une équipe de développeurs à moi tout seul, je crois que ma vie ne suffirait pas... ;)

Voilà on peut faire une coupe cotée rapidement, simplement avec une version pleine d'autocad.

Si tu as un "voyage" de coupe à faire Covadis ou Mensura sont fortement conseillé. :)

(gile) · le 10 octobre 2007

Le fichier donné par lovecraft dans le sujet Challenge11 , se prête bien pour faire un essai.

J'aurais pensé te voir donner une réponse dans le challenge 11. C'est ton domaine, non ?

Connexion

Coupe sur TN

Messages recommandés

xav083

Lien vers le commentaire

Partager sur d’autres sites

lovecraft

Lien vers le commentaire

Partager sur d’autres sites

bonuscad

Lien vers le commentaire

Partager sur d’autres sites

lili2006

Lien vers le commentaire

Partager sur d’autres sites

bonuscad

Lien vers le commentaire

Partager sur d’autres sites

(gile)

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