Lier un attribut de ma longueur de la polyligne dans un bloc.

[liuzzi]

Bonjour,

J'aurais besoin de vos services car je rencontre un problème.

Je voudrais lier un attribut à ma longueur de la polyligne jaune dans un bloc. (photo - bloc réseau avec polyligne).

 

Chaque fois la procédure est la suivante :

Je sélectionne le bloc/l’attribut longueur/insérer un champ/cliquer sur la polyligne et j’obtiens ma longueur du champ (photo - bloc réseau avec polyligne attribut).

Malheureusement, je suis obligé de les faire 1 par 1.

Avez – vous une autre solution ou un lisp pour remédier au problème car j’en ai au moins 200 à faire pour chaque réseau ?

Merci d'avance

[lecrabe]

Hello @liuzzi

 

Voici un Lisp "POLYLENGTH" de Gilles qui ne correspond pas tout a fait a ta demande mais que j utilise souvent !

 

POLYLENGTH ecrit un Champ dynamique du genre "132.5m" sur l ensemble des objets suivants selectionnes :

ARC,CIRCLE,POLYLINE 2D/3D,MPOLYGON,REGION

 

Peut etre que qq un pourra l adapter pour mettre la meme chose dans un Attribut Dynamique !?

 

ET j ai le meme "POLYAREA" pour avoir "132.5m2" ...

 

SVP regler la variable  TEXTSIZE  avant de lancer POLYLENGTH / POLYAREA !

 

Bon WE, Bye, lecrabe

 

 
;; 
;; PolyLength par GC - 03/03/2018 
;;
;; Micro-Modif par Patrice B. 
;; 
;; ------------------------------------------------------------------------------------- 
;; SVP changer la Variable System       TEXTSIZE  AVANT d'executer la Routine ! 
;; Car la routine utilise la valeur de  TEXTSIZE  comme Hauteur de MTEXT par defaut ... 
;; ------------------------------------------------------------------------------------- 
;; 
;; J'ai revu les codes, le probleme venait de la methode utilisee pour placer le texte/champ sur le barycentre de la polyligne. 
;; Cette methode ne fonctionnait qu'avec des polylignes.
;; 
;; J'ai change cela. Le texte est desormais place au centre de la boundingbox de l'entite. 
;; J'ai aussi revu les filtres de selection qui ne devraient pas etre tout à fait les memes pour l'aire et la longueur. 
;; 
;; Pour l'aire, je te laisse choisir entre uniquement les objets fermes, ou pas.
;; 
;; Pour les longueurs, les champs sont differents pour les cercles (Circumference), les regions et mpolygons (Perimeter) 
;; et n'existent pas pour les ELLIPSEs et SPLINEs, j'ai donc remplace le champ par un MTEXT simple qui affiche la longueur.
;; 
;; ---- ATTENTION ---- ELLIPSEs et SPLINEs ---- NON TRAITEES ---- 
;; 
;; %<\AcObjProp Object(%<\_ObjId 1181647088>%).Area \f "%lu2">%
;; %<\AcObjProp Object(%<\_ObjId 1181647088>%).Length \f "%lu2">%
;; %<\AcObjProp Object(%<\_ObjId 1181647088>%).Perimeter \f "%lu2">%
;; %<\AcObjProp Object(%<\_ObjId 1181647088>%).Circumference \f "%lu2">%
;; 
;; Liste sur ELLIPSE --> Aire & Circonference ?? 
;; Liste sur SPLINE  --> Aire & Circonference ??
;; 
;; --- Interrogation Entite/Objet en Lisp ---
;; (entget (car (entsel)) '("*"))
;; 
 
(defun c:PolyLength (/ *error* filter ss acSpace minPt maxPt pt id str txt)
  (vl-load-com)
  (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))))
  (or *util* (setq *util* (vla-get-Utility *acdoc*)))
  (defun *error* (msg)
    (and msg
	 (/= msg "Fonction annulée")
	 (/= msg "Function cancelled")
	 (princ (strcat "Erreur: " msg))
    )
    (vla-EndUndomark *acdoc*)
    (princ)
  )

  (setq	filter (list
		 '(-4 . "<OR") 

;;		 '(0 . "ARC,CIRCLE,LINE,LWPOLYLINE,MPOLYGON,REGION,SPLINE,ELLIPSE") 
		 '(0 . "ARC,CIRCLE,LINE,LWPOLYLINE,MPOLYGON,REGION") 

		 '(-4 . "<AND") 
		 '(0 . "POLYLINE")
		 '(-4 . "<NOT")
		 '(-4 . "&")
		 '(70 . 112)
		 '(-4 . "NOT>")
		 '(-4 . "AND>")
		 '(-4 . "OR>"))
  ) 

 
  (prompt "Hauteur courante de MTEXT - Voir la Variable System TEXTSIZE ... \n"  ) 
  (prompt "---- ATTENTION ---- ELLIPSEs et SPLINEs ---- NON TRAITEES ---- \n") 

  (prompt "POLYLENGTH traite: ARC,CIRCLE,POLYLINE 2D/3D,MPOLYGON,REGION \nSelectionnez les objets ou Entree pour tous ") 

  (if (or (ssget filter)
	  (ssget "_X" (cons (cons 410 (getvar 'ctab)) filter))
      )
    (progn
      (vla-StartUndomark *acdoc*)
      (setq acSpace (vla-get-Block (vla-get-ActiveLayout *acdoc*)))
      (vlax-for	obj (setq ss (vla-get-ActiveSelectionSet *acdoc*))
	(vla-GetBoundingBox obj 'minPt 'maxPt)
	(setq pt  (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.))
			  (vlax-safearray->list minPt)
			  (vlax-safearray->list maxPt)
		  )
	      id  (vla-GetObjectIdString *util* obj :vlax-false)
	      str (cond
		    ((member (vla-get-ObjectName obj) '("AcDbEllipse" "AcDbSpline"))
		      (rtos (strcat (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj)) 2 1) "m")
		    )
		    ((= (vla-get-ObjectName obj) "AcDbCircle")
		     (strcat
		       "%<\\AcObjProp Object(%<\\_ObjId "
		       id
		       ">%).Circumference \\f \"%lu2%pr1%ps[,m]%\">%"
		     )
		    )
		    ((member (vla-get-ObjectName obj) '("AcDbRegion" "AcDbMPolygon"))
		     (strcat
		       "%<\\AcObjProp Object(%<\\_ObjId "
		       id
		       ">%).Perimeter \\f \"%lu2%pr1%ps[,m]%\">%"
		     )
		    )
		    (T
		     (strcat
		       "%<\\AcObjProp Object(%<\\_ObjId "
		       id
		       ">%).Length \\f \"%lu2%pr1%ps[,m]%\">%"
		     )
		    )
		  )
	      txt (vla-addMText acSpace (vlax-3d-point pt) 0. str)
	)
	(vla-put-AttachmentPoint txt acAttachmentPointMiddleCenter)
	(vla-put-insertionPoint txt (vlax-3d-point pt))
      )
      (vla-Delete ss)
    )
  )
  (*error* nil)
)