Aller au contenu
Problème de lien d'inscription (résolu ?) ×

Dessiner l\'oeuf de Christophe Colomb

bonuscad

Par bonuscad
dans Routines LISP

 Partager

Messages recommandés

bonuscad Collaborator

bonuscad

Posté(e)
Posté(e)

Je me régale avec la fonction (grread) qui permet vraiment de faire des trucs sympa en dynamique.

 

Ici c'est pour dessiner une ove, qui pourra être une ove allongée.

L'utilité? ben je ne sais pas, peut être pour la mécanique pour dessiner des cames.

 

En tout cas ça montre les possibilités et peut vous donnez des idées.

(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 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 c:ove ( / o loop value mod ptx l l2 lw el th key pt_drag rad rad2 pt1 pt2 pt3 pt4 cc1 lst a_dir)
(setq o (getvar "osmode") loop T value "")
(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")
		)
	)
)
(initget 1 "Cotes Largeur ELevation EPaisseur _Dimensions Width Elevation Thickness")
(while (not (listp (setq ptx (getpoint "\nSpécifiez le point centre de l'ove ou [Cotes/Largeur/ELévation/EPaisseur]: "))))
	(cond
		((eq ptx "Dimensions")
			(setq l (getdist (strcat "\nSpécifiez le rayon principal de l'ove <" (rtos (getvar "USERR3")) ">:")))
			(if l (setvar "USERR3" l) (setq l (getvar "USERR3")))
			(setq l2 (getdist (strcat "\nSpécifiez le rayon secondaire de l'ove <" (rtos (* 2.0 (getvar "USERR3"))) ">:")))
			(if l2
				(while (or (>= l2 (+ (* 2.0 (getvar "USERR3")) (* (getvar "USERR3") (sqrt 2.0)))) (< l2 (* 2.0 (getvar "USERR3"))))
					(princ (strcat "\nLe rayon doit être > ou = à " (rtos (* 2.0 (getvar "USERR3"))) " et < à " (rtos (+ (* 2.0 (getvar "USERR3")) (* (getvar "USERR3") (sqrt 2.0))))))
					(setq l2 (getdist (strcat "\nSpécifiez le rayon secondaire de l'ove <" (rtos (* 2.0 (getvar "USERR3"))) ">:")))
					(if (not l2) (setq l2 (* 2.0 (getvar "USERR3"))))
				)
				(setq l2 (* 2.0 (getvar "USERR3")))
			)
		)
		((eq ptx "Width")
			(initget 4)
			(setq lw (getdist (strcat "\nSpécifiez la largeur de la polyligne <" (rtos (getvar "PLINEWID")) ">: ")))
			(if lw (setvar "PLINEWID" lw))
		)
		((eq ptx "Elevation")
			(setq el (getdist (strcat "\nSpécifiez l'élévation de l'ovale <" (rtos (getvar "ELEVATION")) ">: ")))
			(if el (setvar "ELEVATION" el))
		)
		((eq ptx "Thickness")
			(setq th (getdist (strcat "\nSpécifiez l'épaisseur de l'ovale <" (rtos (getvar "THICKNESS")) ">: ")))
			(if th (setvar "THICKNESS" th))
		)
	)
	(initget 1 "Cotes Largeur ELevation EPaisseur _Dimensions Width Elevation Thickness")
)
(if (not l)
	(progn
		(princ (strcat "\nSpécifiez le rayon principal de l'ove : <" (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 ptx))
							)
						)
						(setq pt_drag (list (caadr key) (cadadr key) (caddr ptx)))
					)
					(setq
						rad (distance (list (car ptx) (cadr ptx)) (list (car pt_drag) (cadr pt_drag)))
						pt1 (polar ptx (- (angle ptx pt_drag) (/ pi 2.0)) rad)
						pt2 (polar ptx (+ (angle ptx pt_drag) (/ pi 2.0)) rad)
						pt3 (polar pt1 (+ (angle pt1 pt_drag) (/ pi 2.0)) (* 2.0 rad))
						pt4 (polar pt2 (- (angle pt2 pt_drag) (/ pi 2.0)) (* 2.0 rad))
						cc1 (polar pt1 (+ (angle pt1 pt2) (/ pi 4.0)) (* (sqrt 2.0) rad))
					)
					(fig_pts ptx pt1 pt2 rad)
					(fig_pts pt1 pt2 pt3 (* rad 2.0))
					(fig_pts cc1 pt3 pt4 (- (* 2.0 rad) (* (sqrt 2.0) rad)))
					(fig_pts pt2 pt4 pt1 (* rad 2.0))
					(if lst (progn (grvecs lst) (grdraw ptx pt_drag 7)))
					(setq lst nil)
				)
				((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
						pt_drag (polar ptx (angle ptx pt_drag) (getvar "USERR3"))
						rad (getvar "USERR3")
						pt1 (polar ptx (- (angle ptx pt_drag) (/ pi 2.0)) rad)
						pt2 (polar ptx (+ (angle ptx pt_drag) (/ pi 2.0)) rad)
						pt3 (polar pt1 (+ (angle pt1 pt_drag) (/ pi 2.0)) (* 2.0 rad))
						pt4 (polar pt2 (- (angle pt2 pt_drag) (/ pi 2.0)) (* 2.0 rad))
						cc1 (polar pt1 (+ (angle pt1 pt2) (/ pi 4.0)) (* (sqrt 2.0) rad))
						loop nil
					)
					(princ "\n")
				)
				(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)))
				)
			)
		)
		(setvar "USERR3" (distance (list (car ptx) (cadr ptx)) (list (car pt1) (cadr pt1))))
		(setq a_dir (angle cc1 ptx) loop T)
		(princ (strcat "\nSpécifiez le rayon secondaire de l'ove : <" (rtos (* 2.0 (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 ptx))
							)
						)
						(setq pt_drag (list (caadr key) (cadadr key) (caddr ptx)))
					)
					(setq rad2 (distance (list (car ptx) (cadr ptx)) (list (car pt_drag) (cadr pt_drag))))
					(cond
						((>= rad2 (+ (* 2.0 rad) (* rad (sqrt 2.0))))
							(setq rad2 (- (+ (* 2.0 rad) (* rad (sqrt 2.0))) 1E-08))
						)
						((< rad2 (* 2.0 rad))
							(setq rad2 (* 2.0 rad))
						)
					)
					(setq
						pt3 (polar (polar pt2 (angle pt2 pt1) rad2) (+ (angle pt1 pt2) (/ pi 4.0)) rad2)
						pt4 (polar (polar pt1 (angle pt1 pt2) rad2) (- (angle pt2 pt1) (/ pi 4.0)) rad2)
						cc1 (polar ptx (+ (angle pt1 pt2) (/ pi 2.0)) (- rad2 rad))
					)
					(fig_pts ptx pt1 pt2 rad)
					(fig_pts (polar pt2 (angle pt2 pt1) rad2) pt2 pt3 rad2)
					(fig_pts cc1 pt3 pt4 (distance cc1 pt3)) 
					(fig_pts (polar pt1 (angle pt1 pt2) rad2) pt4 pt1 rad2)
					(if lst (progn (grvecs lst) (grdraw ptx pt_drag 7)))
					(setq lst nil)
				)
				((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)))
						(setq rad2 (read value))
						(setq rad2 (* 2.0 rad))
					)
					(cond
						((and (< rad2 (+ (* 2.0 rad) (* rad (sqrt 2.0)))) (>= rad2 (* 2.0 rad)))
							(setq
								pt3 (polar (polar pt2 (angle pt2 pt1) rad2) (+ (angle pt1 pt2) (/ pi 4.0)) rad2)
								pt4 (polar (polar pt1 (angle pt1 pt2) rad2) (- (angle pt2 pt1) (/ pi 4.0)) rad2)
								cc1 (polar ptx (+ (angle pt1 pt2) (/ pi 2.0)) (- rad2 rad))
								loop nil
							)
							(princ "\n")
						)
						(T
							(princ (strcat "\nLe rayon doit être > ou = à " (rtos (* 2.0 (getvar "USERR3"))) " et < à " (rtos (+ (* 2.0 (getvar "USERR3")) (* (getvar "USERR3") (sqrt 2.0))))))
							(princ (strcat "\nSpécifiez le rayon secondaire de l'ove : <" (rtos (* 2.0 (getvar "USERR3"))) ">: "))
							(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)))
				)
			)
		)
		(redraw)
	)
	(setq
		pt1 (polar ptx 0.0 l)
		pt2 (polar ptx pi l)
		pt3 (polar (polar pt2 0.0 l2) (/ (* 5.0 pi) 4.0) l2)
		pt4 (polar (polar pt1 pi l2) (- (/ pi 4.0)) l2)
	)
)
(if (not (zerop (getvar "ELEVATION"))) (setq e (getvar "ELEVATION")))
(setq th (getvar "THICKNESS")  w (getvar "PLINEWID"))
(cond
	((and ptx pt1 pt2 pt3 pt4)
		(setvar "USERR3" (distance (list (car ptx) (cadr ptx)) (list (car pt1) (cadr pt1))))
		(setvar "osmode" 0)
		(setvar "cmdecho" 0)
		(command "_.pline" pt1 "_arc" "_ce" ptx pt2 pt3 pt4 "_close")
		(if e (command "_.change" (entlast) "" "_properties" "_elevation" e ""))
		(if th (command "_.change" (entlast) "" "_properties" "_thickness" th ""))
		(setvar "osmode" o)
		(setvar "cmdecho" 1)
		(if (not a_dir) (command "_.rotate" (entlast) "" "_none" ptx))
	)
)
(prin1)
)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
 Partager
Aller sur la liste des sujets
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité