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

REA pour le longuers de lignes?

Invité ingoenius

Par Invité ingoenius
dans Visual LISP

 Partager

Messages recommandés

Invité ingoenius

Invité ingoenius

Posté(e)
Posté(e)

Salut j'ai trouvé une exellente routine de pATRICK_35

 

qui créé un reacteur text affichant la surface d'une poliligne, est possible de la modifié en faisant afficher dans le cas d'une courbe fermé ca surface et dan le cas d'une coube ouverte ca longueur??

 

 

ici la MAGIQUE routine 

 
;;;=================================================================
;;;
;;; REA.LSP V1.01
;;;
;;; Associer un texte à une poly fermée
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun modif_poly(obj rea arg-list)
 (if (and (vlax-read-enabled-p obj)(vlax-read-enabled-p (vlr-data rea)))
;    (vla-put-textstring (vlr-data rea) (rtos (vla-get-area obj)))
   (vla-put-textstring (vlr-data rea) (strcat (rtos (vla-get-area obj) 2 2) " M²"))
   (vlr-remove rea)
 )
)

(defun effacer_pt(obj rea arg-list)
 (vlax-ldata-delete obj "Patrick_35" (vlr-data rea))
 (vlax-ldata-delete (vlr-data rea) "Patrick_35" obj)
 (vlr-remove rea)
)

(defun c:rea(/ n sel_poly sel_text)
 (while (not sel_poly)
   (setq sel_poly (car (entsel "\nSélection de la polyligne : ")))
   (if sel_poly
     (if (or (= (cdr (assoc 0 (entget sel_poly))) "POLYLINE")
             (= (cdr (assoc 0 (entget sel_poly))) "LWPOLYLINE")
             (= (cdr (assoc 0 (entget sel_poly))) "SPLINE"))
       (progn
         (setq sel_poly (vlax-ename->vla-object sel_poly))
         (if (= :vlax-false (vla-get-closed sel_poly))
           (progn
             (alert "Cette Polyligne/Spline n'est pas fermée")
             (setq sel_poly nil)
           )
         )
         (if sel_poly
           (if (vlax-ldata-get sel_poly "Patrick_35")
             (progn
               (alert "Polyligne/Spline déjà associé à un texte")
               (setq sel_poly nil)
             )
           )
         )
       )
       (progn
         (alert "Ce n'est pas une Polyligne/Spline")
         (setq sel_poly nil)
       )
     )
   )
 )
 (if sel_poly
   (progn
     (vla-highlight sel_poly :vlax-true)
     (while (not sel_text)
       (setq sel_text (car (entsel "\nSélection du texte : ")))
       (if sel_text
         (if (or (= (cdr (assoc 0 (entget sel_text))) "TEXT")
                 (= (cdr (assoc 0 (entget sel_text))) "MTEXT"))
           (progn
             (setq sel_text (vlax-ename->vla-object sel_text))
             (if (vlax-ldata-get sel_text "Patrick_35")
               (progn
                 (alert "Texte déjà associé à une Polyligne/Spline")
                 (setq sel_text nil)
               )
             )
           )
           (progn
             (setq sel_text nil)
             (alert "Ce n'est pas un texte")
           )
         )
       )
     )
     (if sel_text
       (progn
         (vla-highlight sel_poly :vlax-false)
         (vla-put-textstring sel_text (rtos (vla-get-area sel_poly)))
         (vlr-pers (vlr-object-reactor (list sel_poly) sel_text '((:vlr-modified . modif_poly)(:vlr-erased . effacer_pt))))
         (vlr-pers (vlr-object-reactor (list sel_text) sel_poly '((:vlr-erased . effacer_pt))))
         (vlax-ldata-put sel_poly "Patrick_35" sel_text)
         (vlax-ldata-put sel_text "Patrick_35" sel_poly)
       )
     )
   )
 )
 (princ)
)

(defun refaire_reacteurs(/ entp entt)
 (vl-load-com)
 (if (not appli_patrick_35)
   (progn
     (setq appli_patrick_35 (ssget "x" (list (cons 102 "{ACAD_XDICTIONARY"))))
     (if appli_patrick_35
       (progn
         (setq n 0)
         (while (setq entp (ssname appli_patrick_35 n))
           (setq entp (vlax-ename->vla-object entp))
           (if (setq entt (vlax-ldata-get entp "Patrick_35"))
             (progn
               (vla-put-textstring entt (strcat (rtos (/ (vla-get-area entp) 10000) 2 2) " M²"))
               (vlr-object-reactor (list entp) entt '((:vlr-modified . modif_poly)(:vlr-erased . effacer_pt)))
               (vlr-object-reactor (list entt) entp '((:vlr-erased . effacer_pt)))
             )
             (vlax-ldata-delete entp "Patrick_35")
           )
           (setq n (1+ n))
         )
       )
     )
   )
 )
 (princ)
)

(refaire_reacteurs)
(princ "\nREA.LSP chargé. Tapez REA pour l'exécuter")
(princ)

 

 

JE ASSAIEE DE LA MODIFIER MOI MEME MAS SANS AUCUN RESULTAT ;-(

Bred Newbie

Bred

Posté(e)
Posté(e)

Salut,

 

Je me suis permis de modifier le lisp de Patrick_35 pour que ça fasse ce que tu veux, avec en unité le mètre.

... je pense pas qu'il m'en veuille... sinon je m'en excuse par avance.... ;)

 

;;;=================================================================
;;;
;;; REA.LSP V1.01 - MODIFIE PAR BRED
;;;
;;; Associer un texte à une poly fermée
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun modif_poly(obj rea arg-list)
(if (and (vlax-read-enabled-p obj)(vlax-read-enabled-p (vlr-data rea)))
; (vla-put-textstring (vlr-data rea) (rtos (vla-get-area obj)))  
 (if (= :vlax-false (vla-get-closed obj))
   (vla-put-textstring (vlr-data rea) (strcat (rtos (vla-get-length obj)) " M."))
   (vla-put-textstring (vlr-data rea) (strcat (rtos (vla-get-area obj) 2 2) " M²")))
(vlr-remove rea)
)
)

(defun effacer_pt(obj rea arg-list)
(vlax-ldata-delete obj "Patrick_35" (vlr-data rea))
(vlax-ldata-delete (vlr-data rea) "Patrick_35" obj)
(vlr-remove rea)
)

(defun c:rea(/ n sel_poly sel_text lg_poly)
(while (not sel_poly)
(setq sel_poly (car (entsel "\nSélection de la polyligne : ")))
(if sel_poly
(if (or (= (cdr (assoc 0 (entget sel_poly))) "POLYLINE")
(= (cdr (assoc 0 (entget sel_poly))) "LWPOLYLINE")
(= (cdr (assoc 0 (entget sel_poly))) "SPLINE"))
(progn
(setq sel_poly (vlax-ename->vla-object sel_poly))
(if (= :vlax-false (vla-get-closed sel_poly))
(setq lg_poly (vla-get-length sel_poly))
)
(if sel_poly
(if (vlax-ldata-get sel_poly "Patrick_35")
(progn
(alert "Polyligne/Spline déjà associé à un texte")
(setq sel_poly nil)
)
)
)
)
(progn
(alert "Ce n'est pas une Polyligne/Spline")
(setq sel_poly nil)
)
)
)
)
(if sel_poly
(progn
(vla-highlight sel_poly :vlax-true)
(while (not sel_text)
(setq sel_text (car (entsel "\nSélection du texte : ")))
(if sel_text
(if (or (= (cdr (assoc 0 (entget sel_text))) "TEXT")
(= (cdr (assoc 0 (entget sel_text))) "MTEXT"))
(progn
(setq sel_text (vlax-ename->vla-object sel_text))
(if (vlax-ldata-get sel_text "Patrick_35")
(progn
(alert "Texte déjà associé à une Polyligne/Spline")
(setq sel_text nil)
)
)
)
(progn
(setq sel_text nil)
(alert "Ce n'est pas un texte")
)
)
)
)
(if sel_text
(progn
(vla-highlight sel_poly :vlax-false)
(if lg_poly
 (vla-put-textstring sel_text (rtos (vla-get-length sel_poly)))
 (vla-put-textstring sel_text (rtos (vla-get-area sel_poly))))
(vlr-pers (vlr-object-reactor (list sel_poly) sel_text '((:vlr-modified . modif_poly)(:vlr-erased . effacer_pt))))
(vlr-pers (vlr-object-reactor (list sel_text) sel_poly '((:vlr-erased . effacer_pt))))
(vlax-ldata-put sel_poly "Patrick_35" sel_text)
(vlax-ldata-put sel_text "Patrick_35" sel_poly)
)
)
)
)
(princ)
)

(defun refaire_reacteurs(/ entp entt)
(vl-load-com)
(if (not appli_patrick_35)
(progn
(setq appli_patrick_35 (ssget "x" (list (cons 102 "{ACAD_XDICTIONARY"))))
(if appli_patrick_35
(progn
(setq n 0)
(while (setq entp (ssname appli_patrick_35 n))
(setq entp (vlax-ename->vla-object entp))
(if (setq entt (vlax-ldata-get entp "Patrick_35"))
(progn
 (if (= :vlax-false (vla-get-closed entp))
   (vla-put-textstring entt (strcat (rtos (vla-get-length entp)) " M."))
   (vla-put-textstring entt (strcat (rtos (/ (vla-get-area entp) 10000) 2 2) " M²")))
(vlr-object-reactor (list entp) entt '((:vlr-modified . modif_poly)(:vlr-erased . effacer_pt)))
(vlr-object-reactor (list entt) entp '((:vlr-erased . effacer_pt)))
)
(vlax-ldata-delete entp "Patrick_35")
)
(setq n (1+ n))
)
)
)
)
)
(princ)
)

(refaire_reacteurs)
(princ "\nREA.LSP chargé. Tapez REA pour l'exécuter")
(princ)

Si vous êtes persuadés de tout savoir sur un sujet, c''est que vous en ignorez quelque chose...

Invité ingoenius

Invité ingoenius

Posté(e)
Posté(e)

Merci c'est deja super, mais....

ça peu pas aussi fonctionner avec des lignes simple? sans que se soyent nécessairement des poli lignes?

 

et encore les surface des cercles ellipse etc

 

 

et ensuite pourquoi ne pas faire cree automatiquement le texte en demandand seulement le poit d'insertion de celui ci ......

 

quand j'arriverai a etudier correctement le Visual lisp je serai content, ;-)

 

[Edité le 25/4/2008 par ingoenius]

Bred Newbie

Bred

Posté(e)
Posté(e)
ça peu pas aussi fonctionner avec des lignes simple? sans que se soyent nécessairement des poli lignes?

Si tu sélectionne UNE ligne je vois le truc facilement.

Par contre, si tu veux liaisonner une sélections de lignes à un texte, là, faut revoir le code plus profondément...

Si vous êtes persuadés de tout savoir sur un sujet, c''est que vous en ignorez quelque chose...

Invité ingoenius

Invité ingoenius

Posté(e)
Posté(e)

Je pensais seulement a une entité a la fois e que le script gére la création du texte , e le fait de savoir si c'est une ligne une poliligne ouverte ou ferme ou cercle etc

 

PS

j'ai vu que si on ferme le dessin a la réouverture les champs ne sont plus mis a jour,

ou sinon il fau relancer le script??

 

Patrick_35 Newbie

Patrick_35

Posté(e)
Posté(e)

Salut

 

je pense pas qu'il m'en veuille.

Pas du tout, au contraire :D

 

Si mon code peux aider à faire évoluer, j'en suis le premier satisfait.

Mes lisps, une fois diffusés sur la toile ne m'appartiennent plus, sauf que je n'apprécierai pas si qu'une personne s'en accapare ne cite pas ses sources.

 

j'ai vu que si on ferme le dessin a la réouverture les champs ne sont plus mis a jour,

Il faut que le lisp soit chargé (pas obligatoirement lancé) pour que les réacteurs se refassent.

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Bred Newbie

Bred

Posté(e)
Posté(e)

Salut,

Désolé, j'a eu un bug d'ordi samedi et je n'ai pas pu te poster le lisp modifier.

- Tu peux traiter les lignes "simple"

- Tu peux sélectionner un texte existant OU si tu ne le sélectionnes pas, tu devras donner un point d'insertion pour qu'il soit crée dans le style courant.

 

;;;=================================================================
;;;
;;; REA.LSP V1.01
;;; Modifié par Bred avec autorisation :
;;; Traitement ligne seule/ forme ouverte / Création du texte
;;;
;;; Associer un texte à une poly/ligne/spline fermée ou ouverte
;;;
;;; Copyright (C) Patrick_35
;;;
;;;=================================================================

(defun modif_poly(obj rea arg-list)
(if (and (vlax-read-enabled-p obj)(vlax-read-enabled-p (vlr-data rea)))
(if (equal (vla-get-ObjectName obj) "AcDbLine")
 (vla-put-textstring (vlr-data rea) (strcat (rtos (vla-get-length obj)) " M."))
 (if (= :vlax-false (vla-get-closed obj))
   (progn
     (if (equal (vla-get-ObjectName obj) "AcDbSpline")
(vla-put-textstring (vlr-data rea) (strcat (rtos (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))) " M."))
(vla-put-textstring (vlr-data rea) (strcat (rtos (vla-get-length obj)) " M."))))
   (vla-put-textstring (vlr-data rea) (strcat (rtos (vla-get-area obj) 2 2) " M²")))
)
(vlr-remove rea)
)
)

(defun effacer_pt(obj rea arg-list)
(vlax-ldata-delete obj "Patrick_35" (vlr-data rea))
(vlax-ldata-delete (vlr-data rea) "Patrick_35" obj)
(vlr-remove rea)
)

(defun c:rea(/ n sel_poly sel_text lg_poly AcDoc P-TXT)
(setq AcDoc
(if (= (getvar "CVPORT") 1)
(vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))
))
(while (not sel_poly)
(setq sel_poly (car (entsel "\nSélection de la Ligne/Polyligne/Spline : ")))
(if sel_poly
(if (or (= (cdr (assoc 0 (entget sel_poly))) "POLYLINE")
(= (cdr (assoc 0 (entget sel_poly))) "LWPOLYLINE")
(= (cdr (assoc 0 (entget sel_poly))) "SPLINE")
(= (cdr (assoc 0 (entget sel_poly))) "LINE"))
(progn
(setq sel_poly (vlax-ename->vla-object sel_poly))
(if (equal (vla-get-ObjectName sel_poly) "AcDbLine")
 (setq lg_poly (vla-get-length sel_poly))
 (if (= :vlax-false (vla-get-closed sel_poly))
   (progn
     (if (equal (vla-get-ObjectName sel_poly) "AcDbSpline")
(setq lg_poly (vlax-curve-getdistatparam sel_poly (vlax-curve-getendparam sel_poly)))
(setq lg_poly (vla-get-length sel_poly)))))  
)
(if sel_poly
(if (vlax-ldata-get sel_poly "Patrick_35")
(progn
(alert "Ligne/Polyligne/Spline déjà associé à un texte")
(setq sel_poly nil)
)
)
)
)
(progn
(alert "Ce n'est pas une Ligne/Polyligne/Spline")
(setq sel_poly nil)
)
)
)
)
(if sel_poly
(progn
(vla-highlight sel_poly :vlax-true)

(setq sel_text (car (entsel "\nSélection du texte : ")))
(if sel_text
(if (or (= (cdr (assoc 0 (entget sel_text))) "TEXT")
(= (cdr (assoc 0 (entget sel_text))) "MTEXT"))
(progn
(setq sel_text (vlax-ename->vla-object sel_text))
(if (vlax-ldata-get sel_text "Patrick_35")
(progn
(alert "Texte déjà associé à une Ligne/Polyligne/Spline")
(setq sel_text nil)
)
)
)
(progn
(setq sel_text nil)
(alert "Ce n'est pas un texte")
)
)
(progn (setq p-txt (getpoint "\n Point d'insertion du Texte :")
sel_text (vla-AddMText AcDoc (vlax-3d-point p-txt) 1 "TEXTE")))
)


(if sel_text
(progn
(vla-highlight sel_poly :vlax-false)
(if lg_poly
(vla-put-textstring sel_text (rtos lg_poly))
(vla-put-textstring sel_text (rtos (vla-get-area sel_poly))))
(vlr-pers (vlr-object-reactor (list sel_poly) sel_text '((:vlr-modified . modif_poly)(:vlr-erased . effacer_pt))))
(vlr-pers (vlr-object-reactor (list sel_text) sel_poly '((:vlr-erased . effacer_pt))))
(vlax-ldata-put sel_poly "Patrick_35" sel_text)
(vlax-ldata-put sel_text "Patrick_35" sel_poly)
)
)
)
)
(princ)
)

(defun refaire_reacteurs(/ entp entt)
(vl-load-com)
(if (not appli_patrick_35)
(progn
(setq appli_patrick_35 (ssget "x" (list (cons 102 "{ACAD_XDICTIONARY"))))
(if appli_patrick_35
(progn
(setq n 0)
(while (setq entp (ssname appli_patrick_35 n))
(setq entp (vlax-ename->vla-object entp))
(if (setq entt (vlax-ldata-get entp "Patrick_35"))
(progn
(if (equal (vla-get-ObjectName entp) "AcDbLine")
(vla-put-textstring entt (strcat (rtos (vla-get-length entp)) " M."))


 

 
(if (= :vlax-false (vla-get-closed entp))
 (progn
     (if (equal (vla-get-ObjectName sel_poly) "AcDbSpline")
(vla-put-textstring entt (strcat (rtos (vlax-curve-getdistatparam entp (vlax-curve-getendparam entp))) " M."))
(vla-put-textstring entt (strcat (rtos (vla-get-length entp)) " M."))))
 (vla-put-textstring entt (strcat (rtos (/ (vla-get-area entp) 10000) 2 2) " M²")))  
)

(vlr-object-reactor (list entp) entt '((:vlr-modified . modif_poly)(:vlr-erased . effacer_pt)))
(vlr-object-reactor (list entt) entp '((:vlr-erased . effacer_pt)))
)
(vlax-ldata-delete entp "Patrick_35")
)
(setq n (1+ n))
)
)
)
)
)
(princ)
)

(refaire_reacteurs)
(princ "\nREA.LSP chargé. Tapez REA pour l'exécuter")
(princ)

 

Edit : Correction pour Spline ouverte.

 

[Edité le 28/4/2008 par Bred]

Si vous êtes persuadés de tout savoir sur un sujet, c''est que vous en ignorez quelque chose...

Bred Newbie

Bred

Posté(e)
Posté(e)

Salut,

Le testeur fou est passé par là.... ;) ... merci !

: ; erreur: Le serveur ActiveX a renvoyé

l'erreur: nom inconnu: Length

pfffff... bien vu....

Le jour où les Autodesk uniformiseras un peu les propriétés de ces objets, ça nous fera du bien!!!....

 

Je n'ai en effet pas la longueur d'une spline ouverte dans les propriétés activeX.

 

C'est corrigé dans le code précédent.

 

Si vous êtes persuadés de tout savoir sur un sujet, c''est que vous en ignorez quelque chose...

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é