nuages de révision

[bluesisalive]

Bonjour à toutes et à tous,

 

J'aurais aimé savoir s'il était possible de créer des nuages de révision qui aient des formes anguleuses (type explosion dans les BD) plutôt que arrondies.

 

Le but étant d'utiliser les 2 types de nuages (arrondi et anguleux) pour identifier sur le même plan des problèmes ayant trait à différents types de travaux.

 

Merci d'avance,

 

BIA

[lili2006]

Bonjour à toutes et tous,

 

A part les différentes options par défaut, je ne vois pas !

Mais tu peux tout de même convertir des objets et inversé le sens du nuage, peut-être est-ce suffisant pour les distinguer ?

Ou encore jouer sur le type de lignes et/ou la couleur si tu imprimes en couleur,...

 

http://images4.hiboox.com/images/3208/d4dbb8b524453266374b75ed42ee846c.jpg

[zebulon_]

Bonjour,

 

quelque chose qui transforme des nuages en polyligne formée uniquement de segments droits.

 

(defun getPolySegs (ent / entl p1 pt bulge seg ptlst)
 (cond (ent
        (setq entl (entget ent))
        ;; save start point if polyline is closed
        (if (= (logand (cdr (assoc 70 entl)) 1) 1)
          (setq p1 (cdr (assoc 10 entl)))
        )
        ;; run thru entity list to collect list of segments
        (while (setq entl (member (assoc 10 entl) entl))
          ;; if segment then add to list
          (if (and pt bulge)
            (setq seg (list pt bulge))
          )
          ;; save next point and bulge
          (setq pt    (cdr (assoc 10 entl))
                bulge (cdr (assoc 42 entl))
          )
          ;; if segment is build then add last point to segment
          ;; and add segment to list
          (if seg
            (setq seg (append seg (list pt))
                  ptlst (cons seg ptlst))
          )
          ;; reduce list and clear temporary segment
          (setq entl  (cdr entl)
                seg   nil
          )
        )
       )
 )
 ;; if polyline is closed then add closing segment to list
 (if p1 (setq ptlst (cons (list pt bulge p1) ptlst)))
 ;; reverse and return list of segments
 (reverse ptlst)
)


(defun getArcInfo (segment / a p1 bulge p2 c p3 p4 p r s result)
 ;; assigner variables avec les valeurs de l'argument
 (mapcar 'set '(p1 bulge p2) segment)
 (if (not (zerop bulge))
   (progn
     ;; trouver la corde
     (setq c (distance p1 p2))
     ;; trouver la flèche
     (setq s (* (/ c 2.0) (abs bulge)))
     ;; trouver le rayon par Pythagore
     (setq r (/ (+ (expt s 2.0) (expt (/ c 2.0) 2.0)) (* 2.0 s)))
     ;; distance au centre
     (setq a (- r s))
     ;; coordonnées du milieu de p1 et P2
     (setq P4 (polar P1 (angle P1 P2) (/ c 2.0)))
     ;; coordonnées du centre
     (setq p
       (if (>= bulge 0)
         (polar p4 (+ (angle p1 p2) (/ pi 2.0)) a)
         (polar p4 (- (angle p1 p2) (/ pi 2.0)) a)
       )  
     )
     ;; coordonnées de P3
     (setq p3
       (if (>= bulge 0)
         (polar p4 (- (angle p1 p2) (/ pi 2.0)) s)
         (polar p4 (+ (angle p1 p2) (/ pi 2.0)) s)
       )  
     )
     (setq result (list p r))
   )
   (setq result nil)
 )
 result
)

;;; angle par trois points par le "théorème de Carnot"

(defun angle_3pts (som p1 p2 / d1 d2 d3)
 (setq d1 (distance som p1)
       d2 (distance som p2)
       d3 (distance p1 p2)
 )
 (if (and (< 0 d1) (< 0 d2))
   (acos 
     (/ 
       (+ 
         (* d1 d1) 
         (* d2 d2) 
         (- (* d3 d3))
       )
       (* 2 d1 d2)
     )
   )
 )
)

(defun list->variantArray (ptsList / arraySpace sArray)
 ; allocate space for an array of 2d points stored as doubles
 (setq arraySpace
   (vlax-make-safearray
     vlax-vbdouble ; element type
     (cons 0
       (- (length ptsList) 1)
     ) ; array dimension
   )
 )
 (setq sArray (vlax-safearray-fill arraySpace ptsList))
 ; return array variant
 (vlax-make-variant sArray)
)


(defun c:cloud2ang (/ AcDoc Space e eobj segs LSOM DISTonPLINE P1 bulge P2 ANG3P LARC P3 LSOM NewPLINE LAYER CWIDTH)
 (vl-load-com)
 (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object))
       Space (if (= (getvar "CVPORT") 1)
                 (vla-get-PaperSpace AcDoc)
                 (vla-get-ModelSpace AcDoc)
             )
 )
 (setq e (car (entsel)))
 (setq eobj (vlax-ename->vla-object e))
 (setq segs (getpolysegs e))
 (setq LSOM nil)
 (setq DISTonPLINE 0)
 (while segs
   (setq seg (car segs))
   (setq segs (cdr segs))
   (mapcar 'set '(P1 bulge P2) seg)
   (mapcar 'set '(C R) (getarcinfo seg))
   (setq ANG3P (angle_3pts C P1 P2))
   (setq LARC (* ANG3P R))
   (setq P3 (vlax-curve-getpointatdist (vlax-ename->vla-object e) (+ DISTonPLINE (* LARC 0.5))))
   (setq p3 (list (car p3) (cadr p3)))
   (setq DISTonPLINE (+ DISTONPLINE LARC))
   (setq LSOM (append LSOM P1 P3 P2))
 )
 (setq LSOM (List->VariantArray LSOM))
 (setq NewPLINE (vla-addLightweightPolyline space LSOM))
 (setq LAYER (vla-get-layer eobj))
 (setq CWIDTH (vla-get-ConstantWidth eobj))
 (vla-put-layer NewPLINE LAYER)
 (vla-put-ConstantWidth NewPLINE CWIDTH)
 (vla-delete eobj)
 (princ)
) 

 

Amicalement

Vincent

 

[bluesisalive]

Bonsoir à tous,

 

Merci lili2006 pour ces infos.

C'est vrai que les styles de trait et l'inversement devraient suffire ...

 

 

Zebulon,

comment dois-je faire pour pouvoir utiliser ton script?

Je l'ai copier/coller dans un fichier texte que j'ai renommé '*.lsp' mais je n'arrive pas à le lancer... :-S

 

 

Merci

 

BIA

[thry0]

Bjr,

 

Charger le fichier : Outils - AutoLISP - Charger une application ...

Puis lancer la commande : cloud2ang

Ca devrait marcher

[bluesisalive]

Bonjour,

 

merci pour le code seulement... il y a un problème :

 

"

Command: CLOUD2ANG

Select object: *Cancel*

no function definition: ACOS

 

"

 

 

Je dois le modifier?

Comment?

 

 

Merci d'avance.

 

BIA

[thry0]

Re,

 

Chez moi non plus celà ne marche pas ...

même erreur !

 

Plus qu'à attendre ... ;)

 

[Edité le 12/8/2008 par thry0]

[Patrick_35]

Salut

 

Après une recherche sur le forum

 

;;; ACOS Retourne l'arc cosinus du nombre, en radians
(defun ACOS (num)
(if (<= -1 num 1)
(atan (sqrt (- 1 (expt num 2))) num)
(princ
"\nErreur: L'argument pour ACOS doit être compris entre -1 et 1"
)
)
)

 

@+

[zebulon_]

oops, il manquait un bout...

 

;; ASIN et ACOS Retournent l'arc sinus ou l'arc cosinus du nombre, en radians

(defun ASIN (num)
 (if (<= -1 num 1)
   (atan num (sqrt (- 1 (expt num 2))))
   (princ
     "\nErreur: L'argument pour ASIN doit être compris entre -1 et 1"
   )
 )
)

(defun ACOS (num)
 (if (<= -1 num 1)
   (atan (sqrt (- 1 (expt num 2))) num)
   (princ
     "\nErreur: L'argument pour ACOS doit être compris entre -1 et 1"
   )
 )
)

 

C'est vrai que, curieusement, Lisp ne connait pas Asin et Acos. Le Asin ne sert pas dans ce lisp, mais ça vous permet de vous le mettre de côté, si besoin.

Je vois que j'ai les mêmes sources que Patrick_35 ;)

 

Amicalement

Vincent

 

[(gile)]

Salut,

 

Comme je suis peut-être la "source" en question, je me permet de redonner ici une version de ACOS etASIN plus "sûre".

En effet, dans certains cas, j'ai remarqué qu'une tolérance était nécessaire.

 

;;; ASIN et ACOS Retournent l'arc sinus ou cosinus du nombre, en radians

(defun ASIN (num)
 (cond
   ((equal num 1 1e-9) (/ pi 2))
   ((equal num -1 1e-9) (/ pi -2))
   ((     (atan num (sqrt (- 1 (expt num 2))))
   )
 )
)

(defun ACOS (num)
 (cond
   ((equal num 1 1e-9) 0.0)
   ((equal num -1 1e-9) pi)
   ((     (atan (sqrt (- 1 (expt num 2))) num)
   )
 )
) 

[zebulon_]

Salut,

 

Comme je suis peut-être la "source" en question

On ne peut rien te cacher. D'ailleurs, le angle_3pts vient de la même fontaine.

 

Par contre, getPolySegs et getArcInfo viennent d'Afralisp. Comme quoi, il ne faut pas que savoir manger à tous les râteliers, il faut aussi savoir boire à toutes les sources.

 

Pour le reste, c'est du bricolage maison. Quand même... ;)

 

Amicalement

Vincent

 

 

[Edité le 12/8/2008 par zebulon_]

[Patrick_35]

Je vois que j'ai les mêmes sources que Patrick_35 ;)

Je l'ai repiqué sur une des routines de Bred et je n'ai pas fait attention sur le message que l'origine était de (gile) :red:

 

(gile) deviendrait-il universel :D

 

@+