CADxp: Nuage de révision par 2 points - CADxp

Aller au contenu

Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

Nuage de révision par 2 points

#1 L'utilisateur est hors-ligne   zebulon_ 

  • ceinture noire 2em dan
  • Groupe : Membres
  • Messages : 1316
  • Inscrit(e) : 02-mai 03
  • LocationSchnersheim

Posté 11 mars 2016 - 12:05

Bonjour,

le plus souvent, il suffirait de créer le nuage de révision à partir d'un rectangle (donc 2 points), ou d'un cercle (2 points aussi) ou d'une polyligne pas trop compliquée. De plus, les longueurs d'arc pourraient se déterminer automatiquement en fonction de la taille - de l'encombrement - du contour qui sert à générer le nuage. Par défaut, j'ai choisi le 10ème de l'encombrement du contour. Pour finir, ce serait bien que le nuage créé se mette sur un calque "REVCLOUD" (ou autre...)

En fait, je n'aime pas trop le concept du trajet à main levée : faut que j'arrête l'alcool... Souvent, la souris s'égare ou alors j'ai du mal à fermer le contour et ça donne juste une m... et il faut recommencer.

Au moins, avec à la base un rectangle, un cercle ou une polyligne (fermée ou non), c'est plus simple et, pendant le tracé d'une polyligne, on peut revenir en arrière si on s'est un peu égaré en cours de route.

(defun c:recrev (/ AcDoc Space FORME FAC ST MSG PT1 R lelem cmdsave TEMP old_clayer mycmdrev fac_ent get_msg_recrev calque)

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


;;;
;;; lancer une commande autocad

(defun mycmdrev (CMD PT / ETL LELEM RES OLDCMDECHO)
  (setq ETL (entlast))
  (setq OLDCMDECHO (getvar "CMDECHO"))
  (setvar "CMDECHO" 1)
  (command CMD PT)
  (while (not (zerop (getvar "cmdactive")))
    (command pause)
  )
  (setvar "CMDECHO" OLDCMDECHO)
  (setq LELEM nil)
  (if (not ETL) 
    (setq ETL (entnext))
    (setq ETL (entnext ETL))
  )
  (while ETL
    (setq LELEM (cons ETL LELEM))
    (setq ETL (entnext ETL))
  )
  (setq RES LELEM)
)


(defun fac_ent (e / util obj minpoint maxpoint)

  (setq util (vla-get-utility 
                   (vla-get-activedocument 
                        (vlax-get-acad-object))))

  (setq obj (vlax-ename->vla-object e))

  (vla-GetBoundingBox obj 'minpoint 'maxpoint)

  (distance
    (vlax-safearray->list minpoint)
    (vlax-safearray->list maxpoint)
  )
);defun


(defun get_msg_recrev (FORME)
  (cond
    ((= FORME "Rectangulaire")
      "\nSpécifiez le premier coin :"
    )
    ((= FORME "Circulaire")
      "\nSpécifiez le centre :"
    )
    ((= FORME "Polygonal")
      "\nSpécifiez le point de départ :" 
    )
  )
)

;;; créer un calque
(defun calque (NewLayer ColLayer TlLayer LwLayer / LtTable LayerTable aNewLayer)
  (if (not (tblsearch "LTYPE" TlLayer))  ;; charger le style de traits
    (progn
      (setq LtTable (vla-get-LineTypes AcDoc))
      (vla-load LtTable TlLayer "acadiso.lin")
    )
  )
  (setq LayerTable (vla-get-layers AcDoc))
  (if (not (tblsearch "LAYER" NewLayer))
    (progn  ;; créer le calque qui n'existe pas
      (setq aNewLayer (vla-add LayerTable NewLayer))
      (vla-put-color aNewLayer ColLayer)
      (vla-put-LineType aNewLayer TlLayer)
      (vla-put-LineWeight aNewLayer LwLayer)
    )
    (progn  ;; le calque existe -> le rendre disponible
      (setq aNewLayer (vla-item LayerTable NewLayer))
      (if (= (vla-get-Lock aNewLayer) ':vlax-true) 
        (vla-put-Lock aNewLayer :vlax-false)
      )
      (if (= (vla-get-Freeze aNewLayer) ':vlax-true)
        (progn
          (vla-put-Freeze aNewLayer :vlax-false)
          (vla-regen AcDoc acAllViewports)
        )
      )
      (if (= (vla-get-LayerOn aNewLayer) ':vlax-false)
        (vla-put-LayerOn aNewLayer :vlax-true)
      )
    )
  )
  (setvar "CLAYER" NewLayer)  ;; et le rendre actif
)


  (setq cmdsave (getvar "cmdecho"))
  (setvar "cmdecho" 0)

  (or (setq FORME (vlax-ldata-get "CADSYS" "FORME_RECREV"))
    (setq FORME "Rectangulaire")
  )
  (or (setq FAC (vlax-ldata-get "CADSYS" "FAC_RECREV"))
    (setq FAC 0.1)
  )
  (or (setq ST (vlax-ldata-get "CADSYS" "ST_RECREV"))
    (setq ST "Normal")
  )
  (setq MSG (get_msg_recrev FORME))

  (setq PT1 nil)

  (while (/= (type PT1) 'list) 
    (prompt (strcat "\nForme du nuage : " FORME "   Style : " ST "\nFacteur de densité : " (rtos FAC)))
    (initget "Rectangulaire Circulaire Polygonal Style Facteur")
    (or
      (setq PT1 (getpoint (strcat MSG " [Rectangulaire/Circulaire/Polygonal/Style/Facteur] <Facteur> : ")))
      (setq PT1 "Facteur")
    )
    (cond
      ((= PT1 "Facteur")
        (initget 6)  ;; pas de zéro ni de négatif
        (setq TEMP (getdist (strcat "\nNouveau facteur de densité (non nul et inférieur à 0.50)  <" (rtos FAC) "> : ")))
        (if TEMP
          (setq FAC (min TEMP 0.50))
        )
      )
      ((= PT1 "Style")
        (initget "Normal Calligraphie")
        (setq TEMP (getkword (strcat "\nSélectionner le style d'arc : [Normal Calligraphie] <" ST ">")))
        (if TEMP
          (setq ST TEMP)
        )
      )
      ((member PT1 '("Rectangulaire" "Circulaire" "Polygonal"))
        (setq FORME PT1)
        (setq MSG (get_msg_recrev FORME))
      )
    )
  ) 
  (cond
    ((= FORME "Rectangulaire")
      (setq lelem (mycmdrev "_RECTANG" PT1))
    )
    ((= FORME "Circulaire")
      (setq lelem (mycmdrev "_CIRCLE" PT1))
    )
    ((= FORME "Polygonal")
      (setq lelem (mycmdrev "_PLINE" PT1))
    )
  )

  (if lelem
    (progn
      (setq old_clayer (getvar "CLAYER"))
      (setq old_delobj (getvar "DELOBJ"))
      (setvar "DELOBJ" 3)  ;; Supprime toute la géométrie de définition
      (calque "REVCLOUD" 7 "Continuous" 18)
      (setq R (* (fac_ent (car lelem)) FAC))
      (command 
         "_revcloud" 
         "_s" (strcat "_" (substr ST 1 1))
         "_a" R R 
         "_o" (car lelem) 
         "_n"
       )  ;; dessine le nuage
      (vlax-ldata-put "CADSYS" "FORME_RECREV" FORME)
      (vlax-ldata-put "CADSYS" "FAC_RECREV" FAC)
      (vlax-ldata-put "CADSYS" "ST_RECREV" ST)
      (setvar "CLAYER" old_clayer)
      (setvar "DELOBJ" old_delobj)
    )
    (alert "Pas de contour créé")
  )
  (setvar "cmdecho" cmdsave)
  (princ)
)


Amicalement
Vincent
C'est au pied du mur que l'on reconnaît le maçon ! (Anonyme) C’est en restant au pied du mur qu’on ne voit que le mur (Anonyme aussi)
1

#2 L'utilisateur est hors-ligne   grandss 

  • ceinture noire
  • Groupe : Membres
  • Messages : 383
  • Inscrit(e) : 09-juillet 07
  • LocationLuxembourg

Posté 15 mars 2016 - 13:29

Salut,

Super ton Lisp, je l'ai adopté.
Un grand merci.
Autocad MEP 2017
0

#3 L'utilisateur est hors-ligne   zebulon_ 

  • ceinture noire 2em dan
  • Groupe : Membres
  • Messages : 1316
  • Inscrit(e) : 02-mai 03
  • LocationSchnersheim

Posté 15 mars 2016 - 15:54

Bonjour,

en même temps, ce lisp n'aura pas une très grande longévité en tant que tel, compte tenu que la version 2016 (que je n'ai pas encore installée chez moi...) apporte une amélioration importante de ces nuages de révision. Et l'amélioration va, à certains égards, bien plus loin que le lisp , compte tenu que ces nouveaux REVCLOUD sont, d'après ce que j'ai pu voir dans les commentaires ici et là sur la toile, conçus comme des objets étirables par le biais de poignées. Avec 2016, on peut (enfin...) étirer un REVCLOUD comme on étire un rectangle ou une polyligne. Le nuage conserve la géométrie de l'objet qui a servi à le construire et on peut modifier le nuage en modifiant cet objet de base. Pour donner une image, cela ressemble un peu au fonctionnement d'une polyligne qu'on a transformé en sPline via Pedit.

Dès que j'aurai installé 2016, je me pencherai sur la question. Merci à ceux qui utilisent 2016 pour un éventuel retour d'expérience.

Amicalement
Vincent
C'est au pied du mur que l'on reconnaît le maçon ! (Anonyme) C’est en restant au pied du mur qu’on ne voit que le mur (Anonyme aussi)
0

#4 L'utilisateur est hors-ligne   pierrevigneux 

  • ceinture noire
  • Groupe : Membres
  • Messages : 374
  • Inscrit(e) : 21-décembre 09

Posté 15 mars 2016 - 17:02

Merci j'ai pris ma copie.

Bonne fin de journée!
Acadnadien
0

Partager ce sujet :


Page 1 sur 1
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)