Symbôle pente de toit

[x13]

J'aimerais modifier un petit programme afin qu'il fonctionne autant en métrique (mm) qu'en impérial (pouces).

 

Pour le fichier DCL j'ajouterais deux boutons radio, un pour activer les unités métriques et l'autre pour les unités impérials.

 

spacer_1;

: row {

: boxed_radio_row {

label = "Unités de dessin...";

: radio_button {

label = "Pouces";

key = "unit_1";}

: radio_button {

label = "Millimètres";

key = "unit_2";}

 

Pour le fichier LSP, il faudrait contrôler les valeurs de la variable DIMSCALE pour le longueur

des segments du symbôle et la hauteur du texte et le décalage du symbôle p/r a la ligne en pente.

 

Est-ce que le cheminement est correcte ou s'il y a une meilleure façcon de faire?

 

Merçci de votre aide.

 

Voiçi le programme en question.

 

;

;

; DDSLOPE.LSP 3.0

;

; © August 1999, Greg MacGeorge

; DDSLOPE.LSP - Draw slope marks in AutoCad.

 

 

 

; Side (a) and Angle (A) Known

;

(defun aE ()

(setq sidea sidea_len)

(setq sidec (/ sidea (sin anga)))

(setq sideb (sqrt (- (* sidec sidec) (* sidea sidea))))

)

;

;

; Side (b) and Angle (A) Known

;

;

(defun bD ()

(setq sideb sideb_len)

(setq sidec (/ sideb (cos anga)))

(setq sidea (sqrt (- (* sidec sidec) (* sideb sideb))))

)

;

;

;

;

(defun s1 ()

(setq p2x (+ p1x sidea_len))

(setq p2y p1y)

(setq p2 (list p2x p2y))

(setq p3x p2x)

(setq p3y (+ p2y sidea))

(setq p3 (list p3x p3y))

(setq p4x (+ p1x (* 0.5 sidea_len)))

(setq p4y (- p1y xtxt2))

(setq p4 (list p4x p4y))

(setq p5x (+ p2x ytxt))

(setq p5y (+ p2y (* 0.5 sidea)))

(setq p5 (list p5x p5y))

(setq sidea (rtos (* (/ 1 ds) 24 sidea) 5 4))

(command "line" pS p2 p3)

(command "")

(command "text" "c" p4 txtht 0 12)

(command "text" p5 txtht 0 sidea)

)

;

;

;

;

(defun s2 ()

(setq p2x p1x)

(setq p2y (+ p1y sidea_len))

(setq p2 (list p2x p2y))

(setq p3x (+ p2x sideb))

(setq p3y p2y)

(setq p3 (list p3x p3y))

(setq p4x (- p1x ytxt))

(setq p4y (+ p1y (* 0.5 sidea_len)))

(setq p4 (list p4x p4y))

(setq p5x (+ p2x (* 0.5 sideb)))

(setq p5y (+ p2y xtxt1))

(setq p5 (list p5x p5y))

(setq sideb (rtos (* (/ 1 ds) 24 sideb) 5 4))

(command "line" pS p2 p3)

(command "")

(command "text" "r" p4 txtht 0 12)

(command "text" "c" p5 txtht 0 sideb)

)

;

;

;

;

(defun s3 ()

(setq p2x p1x)

(setq p2y (+ p1y sidea_len))

(setq p2 (list p2x p2y))

(setq p3x (- p2x sideb))

(setq p3y p2y)

(setq p3 (list p3x p3y))

(setq p4x (+ p1x ytxt))

(setq p4y (+ p1y (* 0.5 sidea_len)))

(setq p4 (list p4x p4y))

(setq p5x (- p2x (* 0.5 sideb)))

(setq p5y (+ p2y xtxt1))

(setq p5 (list p5x p5y))

(setq sideb (rtos (* (/ 1 ds) 24 sideb) 5 4))

(command "line" pS p2 p3)

(command "")

(command "text" p4 txtht 0 12)

(command "text" "c" p5 txtht 0 sideb)

)

;

;

;

;

(defun s4 ()

(setq p2x (- p1x sidea_len))

(setq p2y p1y)

(setq p2 (list p2x p2y))

(setq p3x p2x)

(setq p3y (+ p2y sidea))

(setq p3 (list p3x p3y))

(setq p4x (- p1x (* 0.5 sidea_len)))

(setq p4y (- p1y xtxt2))

(setq p4 (list p4x p4y))

(setq p5x (- p2x ytxt))

(setq p5y (+ p2y (* 0.5 sidea)))

(setq p5 (list p5x p5y))

(setq sidea (rtos (* (/ 1 ds) 24 sidea) 5 4))

(command "line" pS p2 p3)

(command "")

(command "text" "c" p4 txtht 0 12)

(command "text" "r" p5 txtht 0 sidea)

)

;

;

;

;

(defun s5 ()

(setq p2x (- p1x sidea_len))

(setq p2y p1y)

(setq p2 (list p2x p2y))

(setq p3x p2x)

(setq p3y (- p2y sidea))

(setq p3 (list p3x p3y))

(setq p4x (- p1x (* 0.5 sidea_len)))

(setq p4y (+ p1y xtxt1))

(setq p4 (list p4x p4y))

(setq p5x (- p2x ytxt))

(setq p5y (- p2y (* 0.5 sidea)))

(setq p5 (list p5x p5y))

(setq sidea (rtos (* (/ 1 ds) 24 sidea) 5 4))

(command "line" pS p2 p3)

(command "")

(command "text" "c" p4 txtht 0 12)

(command "text" "r" p5 txtht 0 sidea)

)

;

;

;

;

(defun s6 ()

(setq p2x p1x)

(setq p2y (- p1y sidea_len))

(setq p2 (list p2x p2y))

(setq p3x (- p2x sideb))

(setq p3y p2y)

(setq p3 (list p3x p3y))

(setq p4x (+ p1x ytxt))

(setq p4y (- p1y (* 0.5 sidea_len)))

(setq p4 (list p4x p4y))

(setq p5x (- p2x (* 0.5 sideb)))

(setq p5y (- p2y xtxt2))

(setq p5 (list p5x p5y))

(setq sideb (rtos (* (/ 1 ds) 24 sideb) 5 4))

(command "line" pS p2 p3)

(command "")

(command "text" p4 txtht 0 12)

(command "text" "c" p5 txtht 0 sideb)

)

;

;

;

;

(defun s7 ()

(setq p2x p1x)

(setq p2y (- p1y sidea_len))

(setq p2 (list p2x p2y))

(setq p3x (+ p2x sideb))

(setq p3y p2y)

(setq p3 (list p3x p3y))

(setq p4x (- p1x ytxt))

(setq p4y (- p1y (* 0.5 sidea_len)))

(setq p4 (list p4x p4y))

(setq p5x (+ p2x (* 0.5 sideb)))

(setq p5y (- p2y xtxt2))

(setq p5 (list p5x p5y))

(setq sideb (rtos (* (/ 1 ds) 24 sideb) 5 4))

(command "line" pS p2 p3)

(command "")

(command "text" "r" p4 txtht 0 12)

(command "text" "c" p5 txtht 0 sideb)

)

;

;

;

;

(defun s8 ()

(setq p2x (+ p1x sidea_len))

(setq p2y p1y)

(setq p2 (list p2x p2y))

(setq p3x p2x)

(setq p3y (- p2y sidea))

(setq p3 (list p3x p3y))

(setq p4x (+ p1x (* 0.5 sidea_len)))

(setq p4y (+ p1y xtxt1))

(setq p4 (list p4x p4y))

(setq p5x (+ p2x xtxt2))

(setq p5y (- p2y (* 0.5 sidea)))

(setq p5 (list p5x p5y))

(setq sidea (rtos (* (/ 1 ds) 24 sidea) 5 4))

(command "line" pS p2 p3)

(command "")

(command "text" "c" p4 txtht 0 12)

(command "text" p5 txtht 0 sidea)

)

;

;

;

;

(defun slope-a ()

(setvar "cmdecho" 0)

(setq cl (getvar "clayer"))

(setq ds (getvar "dimscale" ))

(setq st (getvar "textstyle"))

(if (= lay "T")

(setvar "clayer" cl)

(setvar "clayer" lay)

)

(if (= sty "T")

(setvar "textstyle" st)

(setvar "textstyle" sty)

)

(setq sidea_len (* 0.5 ds))

(setq sideb_len (* 0.5 ds))

(setq txtht (* ds 0.0625))

(setq ytxt (* ds 0.125))

(setq xtxt1 (* ds 0.125))

(setq xtxt2 (+ txtht (* ds 0.125)))

(setq a (entsel))

(setq b (car a))

(setq c (entget b))

(setq p1s (assoc 10 c))

(setq p1 (cdr p1s))

(setq p2s (assoc 11 c))

(setq p2 (cdr p2s))

(setq anga (angle p1 p2))

(setq an (angtos anga 0 4))

(setq an (atof an))

(setq quad1 (/ an 45))

(if (= quad1 0) (setq quad "1"))

(if (and (> quad1 0) (<= quad1 1)) (setq quad "1"))

(if (and (> quad1 1) (<= quad1 2)) (setq quad "2"))

(if (and (> quad1 2) (<= quad1 3)) (setq quad "3"))

(if (and (> quad1 3) (<= quad1 4)) (setq quad "4"))

(if (and (> quad1 4) (<= quad1 5)) (setq quad "5"))

(if (and (> quad1 5) (<= quad1 6)) (setq quad "6"))

(if (and (> quad1 6) (<= quad1 7)) (setq quad "7"))

(if (and (> quad1 7) (<= quad1 8)) (setq quad "8"))

(if (= quad "0") (setq quad "1"))

(if (= quad "1") (bD))

(if (= quad "2") (aE))

(if (= quad "3") (aE))

(if (= quad "4") (bD))

(if (= quad "5") (bD))

(if (= quad "6") (aE))

(if (= quad "7") (aE))

(if (= quad "8") (bD))

(setq pS (getpoint "Sélectionnez point de départ du symbole: "))

(setq p1x (car pS))

(setq p1y (cadr pS))

(if (= quad "1") (s5))

(if (= quad "2") (s2))

(if (= quad "3") (s3))

(if (= quad "4") (s8))

(if (= quad "5") (s5))

(if (= quad "6") (s2))

(if (= quad "7") (s3))

(if (= quad "8") (s8))

)

;

;

;

;

(defun slope-b ()

(setvar "cmdecho" 0)

(setq cl (getvar "clayer"))

(setq ds (getvar "dimscale" ))

(setq st (getvar "textstyle"))

(if (= lay "T")

(setvar "clayer" cl)

(setvar "clayer" lay)

)

(if (= sty "T")

(setvar "textstyle" st)

(setvar "textstyle" sty)

)

(setq sidea_len (* 0.5 ds))

(setq sideb_len (* 0.5 ds))

(setq txtht (* ds 0.0625))

(setq ytxt (* ds 0.125))

(setq xtxt1 (* ds 0.125))

(setq xtxt2 (+ txtht (* ds 0.125)))

(setq a (entsel))

(setq b (car a))

(setq c (entget b))

(setq p1s (assoc 10 c))

(setq p1 (cdr p1s))

(setq p2s (assoc 11 c))

(setq p2 (cdr p2s))

(setq anga (angle p1 p2))

(setq an (angtos anga 0 4))

(setq an (atof an))

(setq quad1 (/ an 45))

(if (= quad1 0) (setq quad "1"))

(if (and (> quad1 0) (<= quad1 1)) (setq quad "1"))

(if (and (> quad1 1) (<= quad1 2)) (setq quad "2"))

(if (and (> quad1 2) (<= quad1 3)) (setq quad "3"))

(if (and (> quad1 3) (<= quad1 4)) (setq quad "4"))

(if (and (> quad1 4) (<= quad1 5)) (setq quad "5"))

(if (and (> quad1 5) (<= quad1 6)) (setq quad "6"))

(if (and (> quad1 6) (<= quad1 7)) (setq quad "7"))

(if (and (> quad1 7) (<= quad1 8)) (setq quad "8"))

(if (= quad "1") (bD))

(if (= quad "2") (aE))

(if (= quad "3") (aE))

(if (= quad "4") (bD))

(if (= quad "5") (bD))

(if (= quad "6") (aE))

(if (= quad "7") (aE))

(if (= quad "8") (bD))

(setq pS (getpoint "Selectionnez Point de départ du symbole: "))

(setq p1x (car pS))

(setq p1y (cadr pS))

(if (= quad "1") (s1))

(if (= quad "2") (s6))

(if (= quad "3") (s7))

(if (= quad "4") (s4))

(if (= quad "5") (s1))

(if (= quad "6") (s6))

(if (= quad "7") (s7))

(if (= quad "8") (s4))

)

;

;

;

(defun set_view ()

(if (= vw 1)

(progn

(setq x (dimx_tile "image")

y (dimy_tile "image"))

(start_image "image")

(fill_image 0 0 x y 0)

(slide_image 0 0 x y "ddslope1")

(end_image)))

 

(if (= vw 2)

(progn

(setq x (dimx_tile "image")

y (dimy_tile "image"))

(start_image "image")

(fill_image 0 0 x y 0)

(slide_image 0 0 x y "ddslope2")

(end_image)))

 

)

;

;

;

(defun set_tbl_list ()

(setq elist (tblnext "layer" 1))

(setq code 2)

(setq lay_count 0)

(if (not

(or (= (cdr (assoc 70 elist)) 65) (= (cdr (assoc 70 elist)) 69)))

(setq tbl_list (list (cdr (assoc code elist))))

(setq lay_count (+ lay_count 1))

)

;(setq tbl_list (list (dxf_list 2 (tblnext "layer" 1))))

(while (setq t (tblnext "layer"))

(if (not

(or (= (cdr (assoc 70 t)) 65) (= (cdr (assoc 70 t)) 69)))

(setq tbl_list (cons (cdr (assoc code t)) tbl_list))

(setq lay_count (+ lay_count 1))

)

;(setq tbl_list (cons (dxf_list 2 t) tbl_list))

)

(setq tbl_list (reverse tbl_list))

(start_list "la_list")

(mapcar 'add_list tbl_list)

(end_list)

(setq lay_count (strcat (rtos lay_count 2 0) " calques sont gelés"))

(set_tile "message" lay_count)

 

)

;

;

;

(defun set_lay ()

(setq count lay_draw)

(setq tbl_list2 tbl_list)

(if (= count 0) (setq lay (car tbl_list2)))

(while (> count 0)

(setq tbl_list2 (cdr tbl_list2))

(setq lay (car tbl_list2))

(setq count (- count 1))

)

)

;

;

;

(defun set_style_list ()

(setq elist (tblnext "style" 1))

(setq code 2)

(setq style_count 0)

(if (not

(or (= (cdr (assoc 70 elist)) 65) (= (cdr (assoc 70 elist)) 69)))

(setq st_tbl_list (list (cdr (assoc code elist))))

(setq style_count (+ style_count 1))

)

;(setq tbl_list (list (dxf_list 2 (tblnext "style" 1))))

(while (setq t (tblnext "style"))

(if (not

(or (= (cdr (assoc 70 t)) 65) (= (cdr (assoc 70 t)) 69)))

(setq st_tbl_list (cons (cdr (assoc code t)) st_tbl_list))

(setq style_count (+ style_count 1))

)

;(setq tbl_list (cons (dxf_list 2 t) tbl_list))

)

(setq st_tbl_list (reverse st_tbl_list))

(start_list "st_list")

(mapcar 'add_list st_tbl_list)

(end_list)

 

)

;

;

;

(defun set_style ()

(setq count sty_draw)

(setq tbl_list3 st_tbl_list)

(if (= count 0) (setq sty (car tbl_list3)))

(while (> count 0)

(setq tbl_list3 (cdr tbl_list3))

(setq sty (car tbl_list3))

(setq count (- count 1))

)

)

;

;

;

(defun c:ddslope ()

(setq OLDERR *ERROR*

*ERROR* DDSLOPE_ERR) ;_ end of setq

(setq OS (getvar "OSMODE"))

 

(setvar "cmdecho" 0)

(setq dcl_id (load_dialog "ddslope.dcl"))

 

(if (not (new_dialog "slope" dcl_id))

(exit))

 

(setq x (dimx_tile "image")

y (dimy_tile "image"))

(start_image "image")

(fill_image 0 0 x y 0)

(slide_image 0 0 x y "ddslope1")

(end_image)

 

(setq vw 1)

 

(setq lay "T")

(setq sty "T")

 

(mode_tile "aline" 2)

 

(set_tbl_list)

(set_style_list)

 

(action_tile "la_list" "(setq lay_draw (atoi $value)) (set_lay)")

(action_tile "st_list" "(setq sty_draw (atoi $value)) (set_style)")

(action_tile "aline" "(setq vw 1) (set_view)")

(action_tile "bline" "(setq vw 2) (set_view)")

 

(action_tile "accept" "(done_dialog)")

(action_tile "cancel" "(done_dialog)")

 

 

(start_dialog)

(unload_dialog dcl_id)

 

(if (= vw 1) (slope-a))

(if (= vw 2) (slope-b))

 

(setvar "clayer" cl)

(setvar "textstyle" st)

 

(princ)

 

)

;

;

;

(princ "DDSLOPE 3.0 © Greg MacGeorge, 1999....chargé.")

(terpri)

(princ "C:DDSLOPE")

(print)

;

 

//

// DDSLOPE.DCL 3.0

//

// © August 1999, Greg MacGeorge

// DDSLOPE.DCL - Used to get input for the DDSLOPE.LSP program.

 

 

 

dcl_settings : default_dcl_settings { audit_level = 0; }

 

slope : dialog {

label = "SYMBOLES DE PENTE";

:column {

:image {

key = "image";

width = 20;

aspect_ratio = 0.90;

}

: row {

:text {label = "Calque:";}

:popup_list {

key = "la_list";

fixed_width;

}

}

:row {

:text {label = "Style:";}

:popup_list {

key = "st_list";

fixed_width;

}

}

}

spacer_1;

: boxed_column {

label = "Localisation symbôle de pente";

:radio_button {

key = "aline";

label = "Au dessus de la pente: ";

}

:radio_button {

key = "bline";

label = "Sous la pente:";

}

}

spacer_1;

: boxed_row {

label = "Messages";

: text {

key = "message";

fixed_width;

}

}

:row {ok_button; cancel_button;}

}

//

//

 

 

[Patrick_35]

Salut

Je ne comprends pas ce que tu souhaites faire exactement. Tu as les variables measureinit et mesurement par exemple

 

ps : dans ce que tu ajoutes dans le dcl, pas besoin du 1er row au vu de ta boite de dialogue

 

@+

[zebulon_]

Salut,

 

Toute la série des defun s1, s2, s3 qui se ressemblent beaucoup, mériteraient d'être simplifiée et regroupée dans une seule fonction avec des paramètres, cela réduirait grandement la longueur du code.

 

amicalement

 

Zeb

[bonuscad]

Salut,

 

C'est vrai que tout ça est bien long!

Je te fais une proposition où je m'y suis pris autrement, cela fonctionne dans le SCU courant, sans boite de dialogue et tu positionnes tes traits (longueur, dessus/dessous) et le texte comme tu veux.

 

A essayer! modifier ou adapter à tes besoins ;)

(defun C:SLOPE ( / blp pt_o pt_f sv_osmd e_last dxf_o slope sv_ortho pt_start pt_x t2_slope t1_slope ed_1)
(setvar "cmdecho" 0)
(setq blp (getvar "blipmode"))
(setvar "blipmode" 0)
(initget 9)
(setq pt_o (getpoint "\nSpécifiez le point de départ: "))
(cond
	(pt_o
		(initget 41)
		(setq pt_f (getpoint pt_o "\nChoix du point final: "))
		(cond
			(pt_f
				(setq sv_osmd (getvar "osmode"))
				(setvar "osmode" 0)
				(command "_.ray" pt_o pt_f "")
				(setq
					e_last (entlast)
					dxf_o (trans (cdr (assoc 11 (entget e_last))) 0 1 T)
				)
				(entdel e_last)
				(setq slope (/ (car dxf_o) (cadr dxf_o)) sv_ortho (getvar "orthomode"))
				(setvar "orthomode" 1)
				(setq pt_start (mapcar '/ (mapcar '+ pt_o pt_f) '(2 2 2)))
				(initget 9)
				(setq pt_x (getpoint pt_start "\nSpecifiez la grandeur du gabarit: "))
				(if (eq (car pt_x) (car pt_start))
					(setq t2_slope (rtos slope 2 1) t1_slope (rtos 1 2 0))
					(setq t2_slope (rtos 1 2 0) t1_slope (rtos slope 2 1))
				)
				(repeat 2
					(command "_.dimordinate" pt_start "_text" t1_slope pt_x)
					(command "_aidimtextmove" "_2" (entlast) "" (mapcar '/ (mapcar '+ pt_start pt_x) '(2 2 2)))
					(princ "\nPosition du texte: ")
					(command "_aidimtextmove" "_2" (entlast) "" pause)
					(if (not ed_1) (setq ed_1 (entlast)))
					(setq pt_start (inters pt_o pt_f pt_x (polar pt_x (if (eq (car pt_x) (car pt_start)) 0.0 (/ pi 2.0)) (distance pt_start pt_x)) nil) t1_slope t2_slope)
				)
				(command "_.-group" "_create" "*" "" (entlast) ed_1 "")
				(setvar "orthomode" sv_ortho)
				(setvar "osmode" sv_osmd)
			)
		)
	)
)
(setvar "blipmode" blp)
(setvar "cmdecho" 1)
(prin1)
)

[x13]

Merçci beaucoup d'avoir répondu rapidement.

 

Merçci a Bonuscad pour son programme qui fonctionne très bien. Par contre j'aimerais que la valeur du segment en X soit constant soit 12 ou 250 et que ce soit la valeur du segment en Y qui soit variable.

 

Exemple 4/12, 6/12, 8.5/12 ou 142/250, 121.65/250 etc.

 

La constante 12 est utilisée pour les pentes de toit, tandis que la constante 250 est utilisée pour représenter la pente des éléments de dessin d'atelier de charpente d'acier.

 

Merçci.

 

Françcois

[bonuscad]

Salut

 

Je viens justement la remanier un peu, j'ais rejoins tes observations sans le vouloir, mais je me suis arrêté a mon usage pour coter les pentes de talus sur les profils en travers.

Tu peux essayer de l'ajuster encore a tes besoins (le plus gros est fait) ;)

(defun C:SLOPE ( / blp pt_o pt_f frac_prec sv_osmd e_last dxf_o slope slope_h slope_v nx sv_ortho pt_start pt_x t2_slope t1_slope pt_mid pt_text pt_int ed_1)
(setvar "cmdecho" 0)
(setq blp (getvar "blipmode"))
(setvar "blipmode" 0)
(initget 9)
(setq pt_o (getpoint "\nSpécifiez le point de départ: "))
(cond
	(pt_o
		(initget 41)
		(setq pt_f (getpoint pt_o "\nChoix du point final: "))
		(cond
			(pt_f
				(command "_.undo" "_group")
				(cond
					((null (member (getvar "USERI1") '(1 10 100 1000)))
						(initget "Unité Dizaine Centaine Millier _Unit TEn Hundred THousand")
						(setq frac_prec (getkword "\Précision de la fraction [unité/Dizaine/Centaine/Millier]: "))
						(if (not frac_prec) (setq frac_prec "TEn"))
						(cond
							((eq frac_prec "Unit") (setq slope_v 1))
							((eq frac_prec "TEn") (setq slope_v 10))
							((eq frac_prec "Hundred") (setq slope_v 100))
							((eq frac_prec "THousand") (setq slope_v 1000))
						)
						(setvar "USERI1" slope_v)
					)
					(T (setq slope_v (getvar "USERI1")))
				)
				(setq sv_osmd (getvar "osmode"))
				(setvar "osmode" 0)
				(command "_.ray" pt_o pt_f "")
				(setq
					e_last (entlast)
					dxf_o (trans (cdr (assoc 11 (entget e_last))) 0 1 T)
				)
				(entdel e_last)
				(if (and (not (zerop (car dxf_o))) (not (zerop (cadr dxf_o))))
					(setq 
						slope (abs (/ (car dxf_o) (cadr dxf_o)))
						slope_h (fix (* slope_v slope))
						nx (if (zerop slope_h) 0 (gcd slope_h slope_v))
					)
					(if (zerop (car dxf_o)) (setq slope_v 1 slope_h 0 nx 0) (setq slope_v 0 slope_h 1 nx 0))
				)
				(setq sv_ortho (getvar "orthomode"))
				(while (> nx 1)
					(setq slope_h (/ slope_h nx) slope_v (/ slope_v nx) nx (gcd slope_h slope_v)) 
				)
				(setvar "orthomode" 1)
				(setq pt_start (mapcar '/ (mapcar '+ pt_o pt_f) '(2.0 2.0 2.0)) pt_start (list (car pt_start) (cadr pt_start) 0.0))
				(initget 9)
				(setq pt_x (getpoint pt_start "\nSpecifiez la grandeur du symbole: ") pt_x (list (car pt_x) (cadr pt_x)))
				(if (equal (car pt_x) (car pt_start) 1E-12)
					(setq t2_slope (rtos slope_h 2 0) t1_slope (rtos slope_v 2 0))
					(setq t2_slope (rtos slope_v 2 0) t1_slope (rtos slope_h 2 0))
				)
				(repeat 2
					(command "_.dimordinate" pt_start "_text" t1_slope pt_x)
					(setq pt_mid (mapcar '/ (mapcar '+ pt_start pt_x) '(2.0 2.0 2.0)))
					(if (equal (car pt_x) (car pt_start) 1E-12)
						(setq pt_int (polar pt_x 0.0 (distance pt_start pt_x)))
						(setq pt_int (polar pt_x (/ pi 2.0) (distance pt_start pt_x)))
					)
					(if (and (not (zerop (car dxf_o))) (not (zerop (cadr dxf_o))))
						(setq pt_start (inters pt_o pt_f pt_x pt_int nil))
						(setq pt_start pt_x)
					)
					(setq
						t1_slope t2_slope
						pt_text (polar pt_mid (angle pt_start pt_x) (getvar "dimtxt"))
					)
					(command "_aidimtextmove" "_2" (entlast) "" pt_text)
					(if (not ed_1) (setq ed_1 (entlast)))
				)
				(command "_.-group" "_create" "*" "" (entlast) ed_1 "")
				(setvar "orthomode" sv_ortho)
				(setvar "osmode" sv_osmd)
				(command "_.undo" "_end")
			)
		)
	)
)
(setvar "blipmode" blp)
(setvar "cmdecho" 1)
(prin1)
)

 

Modifcation du code lors de la dernière l'édition du post:

* Ajout de la précision fractionnaire (établie lors du 1er usage)

* Correction de la position du texte qui était mal placé dans certain cas

* Gestion des cas particulier qui provoquaient un échec de la routine (segments horizontaux et verticaux)

* Une seule action d'annulation

Le code (devrait) être plus fiable......

 

[Edité le 13/7/2005 par bonuscad]