fonction de basculement par quadrant (/ pi 4)

[bonuscad]

Bonsoir,

 

Je voulais simplement proposer une fonction qui permet des implantations adaptés par quadrant trigonométrique.

 

C'est juste l'ébauche principale de fonctionnement, après on essaye d'adapter selon ses besoins.

La besoin originel qui à engendrer ce bout de code était de relier des blocs électriques et que les raccordements se fasse entre eux de manière différente par quadrant.

 

Il peut servir aussi a placer des étiquettes avec des ligne de rappel adapter au point par quadrant.

 

Pour tester cette fonction; copier-coller le code qui suit directement en ligne de commande.

Cette fonction ne créer aucun objet et ne change rien au dessin en cours ;)

Pas de risque à tester dans votre dessin en cours.

 

((lambda (/ pt1 pt2 d_x d_y)
  (setq pt1 (getvar "VIEWCTR")
 pt2 pt1
 d_x (* (getvar "viewsize") 0.3)
 d_y (* (getvar "viewsize") 0.3)
  )
  (while (equal pt2 pt1)
    (setq pt2
    ((lambda (/ key pt p1 p2 p3 p4 alpha)
       (princ "\nBloc position ")
       (while (and (setq key (grread T 4 0)) (/= (car key) 3))
	 (cond
	   ((eq (car key) 5)
	    (redraw)
	    (setq pt (cadr key))
	    (setq alpha (angle pt1 pt))
	    (cond
	      ((and (>= alpha 0.0) (< alpha (* pi 0.5)))
	       (setq
		 p1 pt
		 p2 (list (+ (car pt) d_x) (cadr pt))
		 p3 (list (+ (car pt) d_x) (+ (cadr pt) d_y))
		 p4 (list (car pt) (+ (cadr pt) d_y))
	       )
	      )
	      ((and (>= alpha (* pi 0.5)) (< alpha pi))
	       (setq
		 p1 pt
		 p2 (list (car pt) (+ (cadr pt) d_y))
		 p3 (list (- (car pt) d_x) (+ (cadr pt) d_y))
		 p4 (list (- (car pt) d_x) (cadr pt))
	       )
	      )
	      ((and (>= alpha pi) (< alpha (* pi 1.5)))
	       (setq
		 p1 pt
		 p2 (list (- (car pt) d_x) (cadr pt))
		 p3 (list (- (car pt) d_x) (- (cadr pt) d_y))
		 p4 (list (car pt) (- (cadr pt) d_y))
	       )
	      )
	      (T
	       (setq
		 p1 pt
		 p2 (list (car pt) (- (cadr pt) d_y))
		 p3 (list (+ (car pt) d_x) (- (cadr pt) d_y))
		 p4 (list (+ (car pt) d_x) (cadr pt))
	       )
	      )
	    )
	    (if	(> (abs (apply '- (mapcar 'car (list pt1 pt))))
		   (abs (apply '- (mapcar 'cadr (list pt1 pt))))
		)
	      (progn
		(grdraw pt1 (list (car p1) (cadr pt1)) 1)
		(grdraw	(list (car p1) (cadr pt1))
			(list (car p1) (cadr pt))
			1
		)
	      )
	      (progn
		(grdraw pt1 (list (car pt1) (cadr p1)) 1)
		(grdraw	(list (car pt1) (cadr p1))
			(list (car p1) (cadr pt))
			1
		)
	      )
	    )
	    (grdraw p1 p2 7)
	    (grdraw p2 p3 7)
	    (grdraw p3 p4 7)
	    (grdraw p4 p1 7)
	   )
	 )
       )
       (redraw)
       (cadr key)
     )
    )
    )
  )
)
)