Arc par 2 points et sa longueur.

bonuscad · le 18 novembre 2005

Bonjour,

J'ai vu un post sur le forum US

L'idée me plaisait, mais surtout la fonction (factor, que j'ai trouvé géniale.

A prioris c'est une retranscription en lisp d'une équation de Newton, d'après les liens donnés.

J'ai donc "pompé" cette fonction pour faire, à ma façon, le lisp suivant.

(defun factor (arclen chordlen / k n c e)
(setq k (/ chordlen arclen))
(setq n 0)
(repeat 6
	(if (= n 0)
		(setq c (sqrt (- 6 (* 6 k))))
		(setq c (- c (/ (- (sin c) (* k c)) (- e k))))
	)
	(setq e (cos c))
	(setq n (1+ n))
)
c
)
(defun fig_pts (pt_cen pt_begin pt_end rad / inc ang nm p1 p2 p3)
(setq
	inc (angle pt_cen pt_begin)
	ang (+ (* 2.0 pi) (angle pt_cen pt_end))
	nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 36.0)))
)
(repeat nm
	(setq
		p1 (polar pt_cen inc rad)
		inc (+ inc (/ (* pi 2.0) 36.0))
		p2 (polar pt_cen inc rad)
		lst (append lst (list p1 p2))
	)
)
(if lst
	(setq
		p3 (polar pt_cen ang rad)
		lst (append lst (list p2 p3))
	)
)
)
(defun gr-osmode (pt-i str-md / n pt md rap pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt56 pt67 pt78 pt85 one_o)
(setq n (/ (cadr (getvar "screensize")) 5.0))
(setq pt (osnap pt-i str-md))
(while (and (eq (strlen (setq md (substr str-md 1 4))) 4) (not one_o))
	(repeat 2
		(setq
			rap (/ (getvar "viewsize") n)
			pt1 (list (- (car pt) rap) (- (cadr pt) rap) (caddr pt))
			pt2 (list (+ (car pt) rap) (- (cadr pt) rap) (caddr pt))
			pt3 (list (+ (car pt) rap) (+ (cadr pt) rap) (caddr pt))
			pt4 (list (- (car pt) rap) (+ (cadr pt) rap) (caddr pt))
			pt5 (list (car pt) (- (cadr pt) rap) (caddr pt))
			pt6 (list (+ (car pt) rap) (cadr pt) (caddr pt))
			pt7 (list (car pt) (+ (cadr pt) rap) (caddr pt))
			pt8 (list (- (car pt) rap) (cadr pt) (caddr pt))
			pt56 (polar pt (- (/ pi 4.0)) rap)
			pt67 (polar pt (/ pi 4.0) rap)
			pt78 (polar pt (- pi (/ pi 4.0)) rap)
			pt85 (polar pt (+ pi (/ pi 4.0)) rap)
			n (- n 16)
		)
		(if (equal (osnap pt-i md) pt) (setq one_o T))
		(cond
			((and (eq "_end" md) one_o)
				(grdraw pt1 pt2 1) (grdraw pt2 pt3 1) (grdraw pt3 pt4 1) (grdraw pt4 pt1 1)
			)
			((and (eq "_mid" md) one_o)
				(grdraw pt1 pt2 1) (grdraw pt2 pt7 1) (grdraw pt7 pt1 1)
			)
			((and (eq "_cen" md) one_o)
				(grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
				(grdraw pt5 pt7 7) (grdraw pt6 pt8 7)
			)
			((and (eq "_nod" md) one_o)
				(grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
				(grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
			)
			((and (eq "_qua" md) one_o)
				(grdraw pt5 pt6 1) (grdraw pt6 pt7 1) (grdraw pt7 pt8 1) (grdraw pt8 pt5 1)
			)
			((and (eq "_int" md) one_o)
				(grdraw pt1 pt3 1) (grdraw pt2 pt4 1)
			)
			((and (eq "_ins" md) one_o)
				(grdraw pt5 pt2 1) (grdraw pt2 pt6 1) (grdraw pt6 pt8 1) (grdraw pt8 pt4 1) (grdraw pt4 pt7 1) (grdraw pt7 pt5 1)
			)
			((and (eq "_per" md) one_o)
				(grdraw pt1 pt2 1) (grdraw pt1 pt4 1) (grdraw pt8 pt 1) (grdraw pt pt5 1)
			)
			((and (eq "_tan" md) one_o)
				(grdraw pt5 pt56 1) (grdraw pt56 pt6 1) (grdraw pt6 pt67 1) (grdraw pt67 pt7 1) (grdraw pt7 pt78 1) (grdraw pt78 pt8 1) (grdraw pt8 pt85 1) (grdraw pt85 pt5 1)
				(grdraw pt3 pt4 1)
			)
			((and (eq "_nea" md) one_o)
				(grdraw pt1 pt2 1) (grdraw pt2 pt4 1) (grdraw pt4 pt3 1) (grdraw pt3 pt1 1)
			)
		)
	)
	(setq str-md (substr str-md 6) n (/ (cadr (getvar "screensize")) 5.0))
)
)
(defun c:arc_length ( / o mod sv_shmnu p_begin p_end chord_length p_mid p_cen1 p_cen2 x_rad arc_length i_ang value loop key pt_drag lst dxf_210 ss1 ss2)
(setq o (getvar "osmode"))
(if (or (zerop o) (eq (boole 1 o 16384) 16384))
	(setq mod "_none")
	(progn
		(setq mod "")
		(mapcar
			'(lambda (xi xs)
				(if (not (zerop (boole 1 o xi)))
					(if (zerop (strlen mod))
						(setq mod (strcat mod xs))
						(setq mod (strcat mod "," xs))
					)
				)
			)
			'(1 2 4 8 16 32 64 128 256 512)
			'("_end" "_mid" "_cen" "_nod" "_qua" "_int" "_ins" "_per" "_tan" "_nea")
		)
	)
)
(setq sv_shmnu (getvar "SHORTCUTMENU"))
(setvar "SHORTCUTMENU" 11)
(initget 9)
(setq p_begin (getpoint "\n1er point: "))
(initget 41)
(setq p_end (getpoint p_begin "\n2ème point: "))
(setq
	p_end (list (car p_end) (cadr p_end) (caddr p_begin))
	chord_length (distance p_begin p_end)
	p_mid (mapcar '/ (mapcar '+ p_begin p_end) '(2.0 2.0 2.0))
	p_cen1 p_mid
	p_cen2 p_mid
	x_rad (/ chord_length 2.0)
	arc_length (* pi x_rad)
	i_ang pi
	value ""
	loop T
)
(setvar "USERR3" chord_length)
(princ (strcat "\nSpécifiez la longueur de l'arc <" (rtos (getvar "USERR3"))">: "))
(while (and (setq key (grread T 4 0)) (/= (car key) 3) loop)
	(cond
		((eq (car key) 5)
			(redraw)
			(if (and (/= mod "_none") (osnap (cadr key) mod))
				(progn
					(gr-osmode (cadr key) mod)
					(setq
						pt_drag (osnap (cadr key) mod)
						pt_drag (list (car pt_drag) (cadr pt_drag) (caddr p_begin))
					)
				)
				(setq pt_drag (list (caadr key) (cadadr key) (caddr p_begin)))
			)
			(setq arc_length (distance p_begin pt_drag))
			(grtext -2 (rtos arc_length))
			(if (> arc_length chord_length)
				(progn
					(setq
						lst nil
						i_ang (factor arc_length chord_length)
						x_rad (/ chord_length 2.0 (sin i_ang))
						p_cen1 (polar p_begin (+ (angle p_begin p_end) (- (/ pi 2.0) i_ang)) x_rad)
						p_cen2 (polar p_begin (- (angle p_begin p_end) (- (/ pi 2.0) i_ang)) x_rad)
					)
					(setq lst (fig_pts p_cen1 p_begin p_end x_rad))
					(setq lst (fig_pts p_cen2 p_end p_begin x_rad))
					(if lst (progn (grvecs lst) (grdraw p_begin (cadr key) 3)))
				)
				(progn
					(setq
						lst nil
						i_ang pi
						x_rad (/ chord_length 2.0)
						p_cen1 p_mid
						p_cen2 p_mid
					)
					(setq lst (fig_pts p_cen1 p_begin p_end x_rad))
					(setq lst (fig_pts p_cen2 p_end p_begin x_rad))
					(if lst (progn (grvecs lst) (grdraw p_begin (cadr key) 1)))
				)
			)
		)
		((or (member key '((2 13) (2 32))) (eq (car key) 25))
			(if (and (not (zerop (strlen value))) (or (eq (type (read value)) 'INT) (eq (type (read value)) 'REAL)))
				(setvar "USERR3" (read value))
			)
			(setq arc_length (getvar "USERR3"))
			(princ "\n")
			(if (> arc_length chord_length)
				(setq
					lst nil
					i_ang (factor arc_length chord_length)
					x_rad (/ chord_length 2.0 (sin i_ang))
					p_cen1 (polar p_begin (+ (angle p_begin p_end) (- (/ pi 2.0) i_ang)) x_rad)
					p_cen2 (polar p_begin (- (angle p_begin p_end) (- (/ pi 2.0) i_ang)) x_rad)
					loop nil
				)
				(progn
					(princ (strcat "\nValeur doit être plus grande que <" (rtos chord_length) ">: ")) 
					(setq value "")
				)
			)
		)
		(T
			(if (eq (cadr key) 8)
				(progn
					(setq value (substr value 1 (1- (strlen value))))
					(princ (chr 8)) (princ (chr 32))
				)
				(setq value (strcat value (chr (cadr key))))
			)
			(princ (chr (cadr key)))
		)
	)
)
(grtext -2 "")
(redraw)
(if (zerop (getvar "PICKFIRST")) (setvar "PICKFIRST" 1))
(setq dxf_210
	(list
		(caddr (trans '(1.0 0.0 0.0) 0 1 0))
		(caddr (trans '(0.0 1.0 0.0) 0 1 0))
		(caddr (trans '(0.0 0.0 1.0) 0 1 0))
	)
)
(entmake
	(list
		'(0 . "ARC")
		'(100 . "AcDbEntity")
		(if (eq (getvar "CVPORT") 1)
			'(67 . 1)
			'(67 . 0)
		)
		(cons 410 (getvar "CTAB"))
		(cons 8 (getvar "CLAYER"))
		'(100 . "AcDbCircle")
		(cons 10 (trans p_cen1 1 dxf_210))
		(cons 40 x_rad)
		(cons 210 dxf_210)
		'(100 . "AcDbArc")
		(cons 50 (angle (trans p_cen1 1 dxf_210) (trans p_begin 1 dxf_210)))
		(cons 51 (angle (trans p_cen1 1 dxf_210) (trans p_end 1 dxf_210)))

	)
)
(setq ss1 (ssadd))
(ssadd (entlast) ss1)
(entmake
	(list
		'(0 . "ARC")
		'(100 . "AcDbEntity")
		(if (eq (getvar "CVPORT") 1)
			'(67 . 1)
			'(67 . 0)
		)
		(cons 410 (getvar "CTAB"))
		(cons 8 (getvar "CLAYER"))
		'(100 . "AcDbCircle")
		(cons 10 (trans p_cen2 1 dxf_210))
		(cons 40 x_rad)
		(cons 210 dxf_210)
		'(100 . "AcDbArc")
		(cons 50 (angle (trans p_cen2 1 dxf_210) (trans p_end 1 dxf_210)))
		(cons 51 (angle (trans p_cen2 1 dxf_210) (trans p_begin 1 dxf_210)))
	)
)
(setq ss2 (ssadd))
(ssadd (entlast) ss2)
(if (and ss1 ss2 (= 0 (getvar "CMDACTIVE"))) 
	(progn
		(sssetfirst nil ss2)
		(princ "\n<Déplacer Curseur> pour choix; <Entrée>/[Espace]/Click+droit pour finir!.")
		(while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
			(cond
				((eq (car key) 5)
					(if (< (distance p_cen1 (cadr key)) (distance p_cen2 (cadr key)))
						(sssetfirst nil ss1)
						(sssetfirst nil ss2)
					)
				)
			)
		)
	)
)
(command "_.erase")
(setvar "SHORTCUTMENU" sv_shmnu)
(prin1)
)

Ce code devrait fonctionné même dans un SCU non parralèle au SCG. (je suis assez content de moi sur ce coup là), j'ai réussi a déterminer le vecteur d'extrusion (code DXf 210) du scu courant.

PS: lors de la saisie de la longueur en dynamique (l'accroche objet est possible) si le trait virtuel est rouge (la longueur est alors le demi-cercle par défaut), vert (la distance dynamique est valable pour la fonction)

Les 2 solutions possibles sont proposées, il faut mettre en surbrillance celle qu'on veut écarter.

Qu'en pensez vous?

LUDWIG · le 18 novembre 2005

A part le clignotement de la palette de propriétés, ton lisp marche très bien. Il devrait faire parti du package d'autocad : Dessin > Arc > Départ, fin, longueur !

didier · le 18 novembre 2005

Bonjour

BRAVO

Tramber · le 18 novembre 2005

Ouais, très sympa.

En plus, ca permet de préparer le terrain pour une poly sous forme de cercle par 2 arcs, ce qui manque sur AutoCAD je trouve.

bonuscad · le 18 novembre 2005

Merci de vos commentaires, et à Newton pour son équation. ;)

J'avais fait choux-blanc dans mes précédentes réflexions, cette équation était le maillon manquant.

une poly sous forme de cercle par 2 arcs

Avec la longueur d'arc je suppose ? car avec le rayon c'est simple:

(defun c:cerclepl ( / pt_center pt_d ray)

(setvar "cmdecho" 0)

(initget 1)

(setq pt_center (getpoint "\nCentre du cercle: "))

(initget 7)

(setq ray (getdist pt_center "\nRayon: "))

(setq pt_d (polar pt_center 0.0 ray))

(command "_.pline" pt_d "_arc" "_angle" (angtos pi) "_ce" pt_center "_close")

(setvar "cmdecho" 1)

(prin1)

)

(gile) · le 19 novembre 2005

Encore une fois : BRAVO !

Je vais décortiquer calmement cette équation de Newton, j'avais déjà essayé de trouver le rapport entre arc et corde, je butais toujours sur une équation trigonométrique à 2 inconnues...

D'autre part, beaucoup plus modestement, j'avais commis 2 petits LISP pour tracer un arc d'après le centre, le départ (ou le départ, le centre) et la longueur de l'arc.

Je l'ai mis ici.

j'ai réussi a déterminer le vecteur d'extrusion (code DXf 210) du scu courant.

J'avais trouvé un autre moyen de déterminer la direction d'extrusion du SCU courant :

;;; EXTR_DIR Retourne la direction d'extrusion du SCU courant (vecteur)

(defun EXTR_DIR	()
 (mapcar '- (trans '(0 0 1) 1 0) (trans '(0 0 0) 1 0))
)

[Edité le 19/11/2005 par (gile)]

(gile) · le 19 novembre 2005

En regardant la manière dont tu définis dxf_210, j'ai trouvé encore plus simple pour la direction d'extrusion du SCU courant :

(setq dxf_210 (trans '(0 0 1) 1 0 0))

bonuscad · le 19 novembre 2005

Ben :( , c'est sûr que c'est plus court.

Je m'obstinais à chercher dans l'autre sens (SCG -> SCU)

Maintenant que je le vois écrit, cela saute aux yeux ;)

Merci de ta lumière!

Tramber · le 20 novembre 2005

J'ai trouvé un excellent lien (Afralisp)

http://www.afralisp.co.za/lisp/Bulges1.htm

Ca concerne les bulges pollignes mais ca semble tout à fait en rapport. Il y a la fameuse formule.

(gile) · le 16 décembre 2005

une poly sous forme de cercle par 2 arcs, ce qui manque sur AutoCAD je trouve.

Pour transformer un cercle en polyligne circulaire :

;;; Presel_ent
;;; Retourne le nom d'une entité sélectionnée avant ou après le lancement de la commande
;;; fltr_lst : la liste des filtres de sélection pour ssget (ou nil)
;;; msg : l'invite pour le choix des objets (ou "")

(defun presel_ent (fltr_lst msg / set1 ent)
 (if (and (= 1 (getvar "pickfirst"))
   (setq set1 (ssget "_i" fltr_lst))
   (eq 1 (sslength set1))
     )
   (sssetfirst nil nil)
   (progn
     (sssetfirst nil nil)
     (princ msg)
     (while (not (setq set1 (ssget "_:S" fltr_lst)))
(princ msg)
     )
   )
 )
 (setq ent (ssname set1 0))
 ent
)

;;; C:C2PL Transforme un cercle en polyligne (2 arcs)

(defun c:c2pl (/ ent lst cen ray pt1 pt2 elv)
 (if (setq
ent (presel_ent '((0 . "CIRCLE")) "\nSélectionnez un cercle.")
     )
   (setq lst (entget ent)
  cen (cdr (assoc 10 lst))
  ray (cdr (assoc 40 lst))
  pt1 (polar cen 0.0 ray)
  pt2 (polar cen pi ray)
  elv (caddr pt1)
   )
 )
 (foreach pt '(pt1 pt2)
   (set pt (list (car (eval pt)) (cadr (eval pt))))
 )
 (foreach code	'(-1 0 330 5 100 10 40)
   (setq
     lst (vl-remove-if '(lambda (x) (= (car x) code)) lst)
   )
 )
 (command "_regen")
 (entmake (append (list
	     '(0 . "LWPOLYLINE")
	     '(100 . "AcDbEntity")
	     '(100 . "AcDbPolyline")
	     '(90 . 2)
	     '(70 . 1)
	     (cons 10 pt1)
	     '(42 . 1.0)
	     (cons 10 pt2)
	     '(42 . 1.0)
	     (cons 38 elv)
	   )
	   lst
   )
 )
 (entdel ent)
 (princ)
)

Connexion

Arc par 2 points et sa longueur.

Messages recommandés

bonuscad

Lien vers le commentaire

Partager sur d’autres sites

LUDWIG

Lien vers le commentaire

Partager sur d’autres sites

didier

Lien vers le commentaire

Partager sur d’autres sites

Tramber

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

(gile)

Lien vers le commentaire

Partager sur d’autres sites

bonuscad

Lien vers le commentaire

Partager sur d’autres sites

Tramber

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