Arc par son centre, son départ et sa longueur

[(gile)]

Voici deux (trois) petites routines pour tracer un arc de cercle d'après son centre, son départ (ou son départ, son centre) et sa longueur. (plus une d'après le départ, la fin et la longueur de l'arc)

 

La longueur de l'arc peut être spécifiée à l'écran, au clavier, à l'aide de la calculatrice géométrique (CAL) ou d'après la longueur ou le périmètre de l'objet sélectionné.

 

;;; ARC_CDL, ARC_DCL et ARC_DEL Pour tracer des arcs d'après leur longueur -22/12/05-

;;; GETLONG Demande à l'utilisateur de spécifier une longueur, soit avec GETDIST, soit en
;;; sélectionnant un objet, soit en utilisant la calculatrice géométrique.
;;; NOTA : init_lst est la liste des arguments pour la fonction initget
;;;        ex: (GETLONG '(7 "Objet Calcul") "\nSpécifiez la longueur ou [Objet/Calcul]: ")

(defun GETLONG (init_lst msg / long)
 (apply 'initget init_lst)
 (setq	long (getdist msg)
 )
 (cond
   ((= long "Objet")
    (while (not (numberp long))
      (setq long (LONGOBJT (entsel)))
    )
   )
   ((= long "Calcul")
    (if (not (member "geomcal.arx" (arx)))
      (arxload "geomcal")
    )
    (setq long (C:CAL))
   )
 )
 long
)

;;; GETVAL Retourne la valeur dxf pour le code spécifié de l'entité
;;; Fonctionne avec des entités de type ENAME, liste ENTSEL ou liste ENTGET

(defun GETVAL (grp ele)
 (cond
   ((= (type ele) 'ENAME)
    (cdr (assoc grp (entget ele)))
   )
   ((not ele) nil)
   ((not (listp ele)) nil)
   ((= (type (car ele)) 'ENAME)
    (cdr (assoc grp (entget (car ele))))
   )
   (T (cdr (assoc grp ele)))
 )
)

;;; LONGOBJT Retourne la longueur ou le périmètre d'un objet

(defun LONGOBJT	(objt)
 (cond
   ((= (GETVAL 0 objt) "LINE")
    (distance (GETVAL 10 objt) (GETVAL 11 objt))
   )
   ((= (GETVAL 0 objt) "ARC")
    (* (ANGARC objt) (GETVAL 40 objt))
   )
   ((member (GETVAL 0 objt)
     '("CIRCLE" "ELLIPSE" "LWPOLYLINE" "SPLINE")
    )
    (command "_area" "_object" objt)
    (getvar "perimeter")
   )
   ((= (type (car objt)) 'ENAME)
    (princ "\nLa longueur de cet objet n'est pas définie.")
   )
 )
)

;;; ANGARC Retourne l'angle décrit par un arc de cercle (en radians).

(defun ANGARC (arc / ang)
 (setq	ang (- (GETVAL 51 arc)
       (GETVAL 50 arc)
    )
 )
 (if (minusp ang)
   (setq ang (+ (* 2 pi) ang))
 )
 ang
)

;;; FACTOR Détermination du demi angle de l'arc à partir de sa corde et de sa longueur

(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
)

;;; LST_DEL Constitution de la liste entmake de l'arc pour arc_del

(defun lst_del (dep ext long / ucszdir cord ang ray mid cen ang0 ang1)
 (setq	ucszdir	(trans '(0 0 1) 1 0 0)
cord	(distance dep ext)
ang	(factor long cord)
ray	(abs (/ cord 2 (sin ang)))
mid	(mapcar '/ (mapcar '+ dep ext) '(2.0 2.0 1.0))
 )
 (if (equal (/ pi 2) ang 1e-009)
   (setq cen mid
  ray (/ cord 2)
   )
   (setq
     cen (polar mid (+ (angle dep ext) (/ pi 2)) (* ray (cos ang)))
   )
 )
 (foreach pt '(cen dep ext)
   (set pt (trans (eval pt) 1 ucszdir))
   )
 (setq	ang0 (angle cen dep)
ang1 (angle cen ext)
 )
 (list	'(0 . "ARC")
(cons 10 cen)
(cons 40 ray)
(cons 50 ang0)
(cons 51 ang1)
(cons 210 ucszdir)
 )
)

;;; LST_CDL Constitution de la liste entmake de l'arc pour arc_cdl et arc _dcl

(defun LST_CDL (cn dep long / ray ang ang0 ang1 ucszdir)
 (setq	ucszdir	(trans '(0 0 1) 1 0 0)
ray	(distance cen dep)
ang0	(angle (trans cen 1 ucszdir) (trans dep 1 ucszdir))
ang	(/ long ray)
ucszdir	(trans '(0 0 1) 1 0 0)
cen	(trans cen 1 ucszdir)
 )
 (initget "Horaire Trigonométrique")
 (if
   (= (getkword
 "\nEntrez le sens de rotation [Horaire/Trigonométrique] < T >: "
      )
      "Horaire"
   )
    (setq temp	ang0
   ang0	(- ang0 ang)
   ang1	temp
   temp	nil
    )
    (setq ang1 (+ ang0 ang))
 )
 (list	'(0 . "ARC")
(cons 10 cen)
(cons 40 ray)
(cons 50 ang0)
(cons 51 ang1)
(cons 210 ucszdir)
 )
)

;;; C:ARC_CDL Crée un arc à partir d'un centre, d'un point de départ et de la longueur de l'arc

(defun c:arc_cdl (/ cen dep long)
 (initget 1)
 (setq cen (getpoint "\nSpécifiez le centre de l'arc: "))
 (initget 1)
 (setq dep (getpoint cen "\nSpécifiez le point de départ de l'arc: "))
 (setq	long (GETLONG
       '(7 "Objet Calcul")
       "\nSpécifiez la longueur de l'arc ou [Objet/Calcul]: "
     )
 )
 (command "_regen")
 (entmake (LST_CDL cen dep long))
 (princ)
)

;;; C:ARC_DCL Crée un arc à partir d'un point de départ, d'un centre et de la longueur de l'arc

(defun c:arc_dcl (/ cen dep long)
 (initget 1)
 (setq dep (getpoint "\nSpécifiez le point de départ de l'arc: "))
 (initget 1)
 (setq cen (getpoint dep "\nSpécifiez le centre de l'arc: "))
 (setq	long (GETLONG
       '(7 "Objet Calcul")
       "\nSpécifiez la longueur de l'arc ou [Objet/Calcul]: "
     )
 )
 (command "_regen")
 (entmake (LST_CDL cen dep long))
 (princ)
)

;;; C:ARC_DEL Crée un arc à partir d'un point de départ, d'un point d'arrivée et de la longueur de l'arc

(defun c:arc_del (/ dep ext long)
 (initget 1)
 (setq dep (getpoint "\nSpécifiez le point de départ de l'arc: "))
 (initget 1)
 (setq ext (getpoint dep "\nSpécifiez l'extrémité de l'arc: "))
 (setq	long (GETLONG
       '(7 "Objet Calcul")
       "\nSpécifiez la longueur de l'arc ou [Objet/Calcul]: "
     )
 )
 (command "_regen")
 (entmake (LST_DEL dep ext long))
 (princ)
)

 

Les sous-routines GETVAL, GETLONG, LONGOBJT et ANGARC peuvent servir à d'autres routines, il peut être avantageux de les mettre (avec d'autres) dans un fichier "Mes_Utils.lsp" chargé à chaque démarrage, pour les appeler dans différents LISP sans avoir à les redéfinir à chaque fois.

 

Elles me servent, par exemple, dans cette routine qui modifie la longueur d'un objet d'après la longueur ou le périmètre d'un objet sélectionné :

 

;;; C:LONG_OBJT 10/04/05
;;; Modifie la longueur totale en fonction de la longueur (ou du périmètre) de l'objet sélectionné.
;;; [surligneur]NOTA : GETVAL, LONGOBJT et ANGARC doivent être chargés [/surligneur] 

;;; Redéfinition de *error*
(defun STD_ERR (msg)
 (if (/= msg "quitter / sortir abandon")
   (princ (strcat "\nErreur: " msg))
 )
 (command)
 (command "_undo" "_end")
 (if lst_var
   (RESTORE_VAR)
 )
 (setq	*error*	m:err
m:err nil
 )
 (princ)
)

;;; SAVE&SET_VAR & RESTORE_VAR
;;;
;;; SAVE&SET_VAR Enregistre la valeur initiale de la variable système dans une liste associative
;;; et lui attribue sa nouvelle valeur
;;; ex: (SAVE&SET_VAR "osmode" 0) -> !lst_var = (("osmode" . 43)) osmode = 0
(defun SAVE&SET_VAR (var val)
 (if (getvar var)
   (if	(/= (getvar var) val)
     (progn
(if (not (member (assoc var lst_var) lst_var))
  (setq lst_var (cons (cons var (getvar var)) lst_var))
)
(setvar var val)
     )
   )
   (princ (strcat "\nErreur: variable AutoCAD rejetée: " var))
 )
)

;;; RESTORE_VAR Restaure leurs valeurs initiales aux variables système de "lst_var"
(defun RESTORE_VAR () 
 (foreach pair	lst_var
   (if	(/= (getvar (car pair)) (cdr pair))
     (setvar (car pair) (cdr pair))
   )
 )
 (setq lst_var nil)
)

;;; Fonction principale

(defun C:LONG_OBJT (/ dist)
 (setq	m:err	*error*
*error*	STD_ERR
 )
 (command "_undo" "_begin")
 (SAVE&SET_VAR "cmdecho" 0)
 (sssetfirst nil)
 (while (not (numberp dist))
   (setq dist (LONGOBJT
	 (entsel
	   "\nChoix de l'objet déterminant la longueur totale: "
	 )
       )
   )
 )
 (princ dist)
 (command "_lengthen" "_total" dist)
 (command "_undo" "_end")
 (RESTORE_VAR)
 (setq	*error*	m:err
m:err nil
 )
 (princ)
) 

 

PS : les sous-routines STD_ERR, SAVE&SET_VAR et RESTORE_VAR pourraient aussi être définies dans "Mes_Utils.lsp".[Edité le 19/11/2005 par (gile)][Edité le 19/11/2005 par (gile)]

[Edité le 22/12/2005 par (gile)]

[didier]

Bonjour,

 

je me suis permis de sévir dans le domaine des arcs, moi aussi

en suivant ce lien, vous trouverez différentes formules :

 

http://www.cadxp.com...Forum-1949.htm

 

amicalement

[didier]

re bonjour,

 

j'entends déjà les scrongneugneu,

donc j'explicite :

 

ouvrir le fichier

 

Taper Alt+F8

 

ça donne :

 

http://img481.imageshack.us/img481/8201/cadxp148ox.png

 

sélectionner la première macro:

 

ça donne :

 

http://img481.imageshack.us/img481/1603/cadxp157oa.png

 

sélectionner l'arc du dessin ...

 

le code est libre d'accès, par Alt+F11

 

amicalement

[(gile)]

Non, non, pas scrongneugneu du tout, çà a bien marché du premier coup, et je suis tout simplement impressionné.

 

Je n'ose même envisager de tenter quelque chose d'équivalent en lisp/dcl (je ne suis qu'un piètre "bidouilleur" et le dcl est fort ingrat).

 

Je ne connais pas du tout le VBA, mais je vais quand même essayer d'y jeter un coup d'oeil.

 

Juste un petit truc, quand on quitte la boite de dialogue avec le bouton "quitter", l'effet est saisissant, mais si on veut relancer la commande, de la boite n'apparaît plus que le coin supérieur gauche :

 

http://img511.imageshack.us/img511/3885/didier6il.png

 

PS : ANGBASE au Nord, ANGDIR à 1 et AUNITS à 2 c'est un truc de géomètre ?

Excuse l'incurie, je suis néophyte. Mais je me rend compte qu'il faut que j'intègre ces parmètres dans certain de mes LISP !

 

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

[bonuscad]

PS : ANGBASE au Nord, ANGDIR à 1 et AUNITS à 2 c'est un truc de géomètre ?

Excuse l'incurie, je suis néophyte. Mais je me rend compte qu'il faut que j'intègre ces parmètres dans certain de mes LISP !

 

Tout à fait :D

Le géomètre travaille en grade, dans le sens horaire et l'origine au Nord.

 

C'est sur que quand je vois des lisps qui travaille en degré pour fournir l'angle à une commande Autocad, généralement sous la forme:

(/ (* angle_radian 180) pi) , je sais d'avance que ce lisp poseras un problème pour les angles suivant dans le dessin dans lequel il sera employé.

 

Personnellement, je travaille en radians dans mes lisp (valeur par défaut employé dans la base DXF de n'importe quel dessin)

Quand il faut fournir un angle à une commande, au lieu de me casser la tête pour fournir la valeur de l'angle dans l'unité utilisée, j'utilise la définition de l'angle en montrant deux point calculé avec la fonction (polar point angle distance) qui elle travaille toujours en radians.

De cette manière je suis sur de l'angle fourni de cette manière à la commande sera bon quelque soit le système angulaire utilisé.

En plus c'est plus précis que de passer par le formatage fait par (angtos)

 

Je trouve insolite que les angles soient accepté sous forme de réel, mais aussi sous forme de chaine de texte tel que retourné par (angtos) alors que l'interprétation n'est pas différente (l'angle sousmis est considéré dans les système angulair actif, réél ou texte)

 

L'interprétation ne devrait pas être identique, cela serait plus simple.

une valeur réelle devrait être considéré en radians et converti pour le système angulaire actif.

Une valeur chaine interprété tel quel dans le système angulaire actif.

 

[Tramber]

Je n'ose même envisager de tenter quelque chose d'équivalent en lisp/dcl (je ne suis qu'un piètre "bidouilleur" et le dcl est fort ingrat).

 

Il suffit de bosser avec objectdcl, ca marche super bien,...et en lisp.

[(gile)]

J'ai modifié le premier LISP (arc_cdl et arc_cdl) et lui ai rajouté une nouvelle fonction arc_del (arc départ, fin, longueur de l'arc) grace à la routine (factor) trouvée par Bonuscad.

 

Il y a maintenant de quoi rajouter une ligne à trois paragraphes du sous-menu Arc.