Réalisation d\'un listings de polylignes.

[olivier29]

Bonjour à tous.

 

je suis actuellement en train de réaliser un projet long de 5 kilomètres.

il m'est demandé de faire un métré de bordure.jusque là pas de souci.

sauf que je doit séparer les bordures en alignement droit des bordures en courbes.

 

existe-t-il un manip, une routine me permettant de sélectionner les polylignes et qu'il me donne les longueurs droites et les longueurs en courbe?

 

j'ai covadis sur mon PC et je n'ai sais pas si c'est possible de le faire.

 

merci d'avance.

[(gile)]

Salut,

 

Un truc comme ça ?

 

;; POLYLEN (gile)

(defun c:PolyLen (/ ss rlen clen pa p1 p2 bu)
 (vl-load-com)
 (setq	rlen 0
clen 0
 )
 (if (ssget '((0 . "LWPOLYLINE")))
   (progn
     (vlax-for	pl (setq ss (vla-get-ActiveSelectionSet
		      (vla-get-ActiveDocument
			(vlax-get-acad-object)
		      )
		    )
	   )
(setq pa 0)
(while (and (setq p1 (vlax-curve-getPointAtParam pl pa))
	    (setq p2 (vlax-curve-getPointAtParam pl (1+ pa)))
	    (setq bu (vla-getBulge pl pa))
       )
  (if (= bu 0.0)
    (setq rlen (+ rlen (distance p1 p2)))
    (setq clen (+ clen (PolyArcLength p1 p2 bu)))
  )
  (setq pa (1+ pa))
)
     )
     (vla-delete ss)
   )
 )
 (princ (strcat "\nTotal rectiligne : "
	 (rtos rlen)
	 "\nTotal curviligne : "
	 (rtos clen)
 )
 )
 (princ)
)

;; PolyArcLength (gile)
;; Retourne la longueur d'un arc de polyligne
;;
;; Arguments
;; p1 p2 : points de départ et de fin du segment
;; bu : courbure de l'arc (bulge)

(defun PolyArcLength (p1 p2 bu / ang rad)
 ((lambda (a)
    (* 2 a (/ (distance p1 p2) (* 2 (sin a))))
  )
   (* 2 (atan bu))
 )
)

[lecrabe]

 

Hello Gilles

 

Comme d'habitude, c nickel-chrome ! :)

 

Routine testée et validée sur un MAP 2004

 

Rappel: elle ne traite pas les polylignes lissées ou splinées :exclam:

 

Encore merci, Le Decapode

 

[(gile)]

Voilà une version qui traite tous les types de polylignes (polylignes optimisées, polylignes 2d simples, lissées ou splinées, polylignes 3d) .

NOTA : les polylignes 2d splinées étant constituées de segments droits, leurs longueurs sont comptabilisées avec les parties rectilignes.

 

;; POLYLEN (gile)

(defun c:PolyLen (/ ss rlen clen pa p1 p2 bu)
 (vl-load-com)
 (setq	rlen 0
clen 0
 )
 (if (ssget '((-4 . "	       (0 . "LWPOLYLINE")
       (-4 . "	       (0 . "POLYLINE")
       (-4 . "	       (-4 . "&")
       (70 . 112)
       (-4 . "NOT>")
       (-4 . "AND>")
       (-4 . "OR>")
      )
     )
   (progn
     (vlax-for	pl (setq ss (vla-get-ActiveSelectionSet
		      (vla-get-ActiveDocument
			(vlax-get-acad-object)
		      )
		    )
	   )
(cond
  ((or (= (vla-get-ObjectName pl) "AcDbPolyline")
       (and (= (vla-get-ObjectName pl) "AcDb2dPolyline")
	    (= 0 (vla-get-Type pl))
       )
   )
   (setq pa 0)
   (while
     (and (setq p1 (vlax-curve-getPointAtParam pl pa))
	  (setq p2 (vlax-curve-getPointAtParam pl (1+ pa)))
	  (setq bu (vla-getBulge pl pa))
     )
      (if (= bu 0.0)
	(setq rlen (+ rlen (distance p1 p2)))
	(setq clen (+ clen (PolyArcLength p1 p2 bu)))
      )
      (setq pa (1+ pa))
   )
  )
  ((and	(= (vla-get-ObjectName pl) "AcDb2dPolyline")
	(= 1 (vla-get-Type pl))
   )
   (setq clen (+ clen
		 (vlax-curve-getDistAtParam
		   pl
		   (vlax-curve-getEndParam pl)
		 )
	      )
   )
  )
  (T
   (setq rlen (+ rlen
		 (vlax-curve-getDistAtParam
		   pl
		   (vlax-curve-getEndParam pl)
		 )
	      )
   )
  )
)
     )
     (vla-delete ss)
   )
 )
 (princ (strcat "\nTotal rectiligne : "
	 (rtos rlen)
	 "\nTotal curviligne : "
	 (rtos clen)
 )
 )
 (princ)
)

;; PolyArcLength (gile)
;; Retourne la longueur d'un arc de polyligne
;;
;; Arguments
;; p1 p2 : points de départ et de fin du segment
;; bu : courbure de l'arc (bulge)

(defun PolyArcLength (p1 p2 bu / ang rad)
 ((lambda (a)
    (* 2 a (/ (distance p1 p2) (* 2 (sin a))))
  )
   (* 2 (atan bu))
 )
)

[(gile)]

Pour les polylignes 2d lissées et splinées, on peut aussi les convertir en polylignes optimisées.

Ceci "fige" les polylignes et fait perdre la possibilité de modifier le type d'ajustage/lissage via la fenêtre de propriétés.

 

;; LWCONVERT (gile)
;; Convertit les polylignes 2d (splinées ou lissées) en polylignes optimisées

(defun c:lwconvert (/ ss fltr n)
 (princ
   "\nSélectionnez les polylignes 2d "
 )
 (setq	fltr '((0 . "POLYLINE")
       (-4 . "	       (-4 . "&")
       (70 . 120)
       (-4 . "NOT>")
      )
 )
 (if
   (or	(setq ss (ssget fltr))
(setq ss (ssget "_X" fltr))
   )
    (progn
      (setq n -1)
      (while (setq pl (ssname ss (setq n (1+ n))))
 (OldStyle2LwPolyline pl)
      )
    )
 )
 (princ)
)


;; OldStyle2LwPolyline
;; Remplace une polyligne 2d par une polyligne optimisée
;;
;; Argument : polyligne 2d (ename)
;; Retour : polyligne optimisée (ename)

(defun OldStyle2LwPolyline (pl / plst xdata vtx vlst elst)
 (setq	plst  (entget pl '("*"))
xdata (assoc -3 plst)
vtx   (entnext pl)
 )
 (while (= (cdr (assoc 0 (setq vlst (entget vtx)))) "VERTEX")
   (if	(zerop (logand (cdr (assoc 70 vlst)) 16))
     (setq elst (cons (vl-remove-if-not
		 '(lambda (x) (member (car x) '(10 40 41 42)))
		 vlst
	       )
	       elst
	 )
     )
   )
   (setq vtx (entnext vtx))
 )
 (if (setq new
     (entmakex
       (append
	 (list
	   '(0 . "LWPOLYLINE")
	   '(100 . "AcDbEntity")
	   (assoc 410 plst)
	   (assoc 8 plst)
	   (cond
	     ((assoc 39 plst))
	     (T '(39 . 0))
	   )
	   '(100 . "AcDbPolyline")
	   (cons 90 (length elst))
	   (cons 70 (logand 129 (cdr (assoc 70 plst))))
	   (cons 38 (last (caar elst)))
	   (assoc 210 plst)
	 )
	 (apply 'append (reverse elst))
	 (if xdata
	   (list xdata)
	 )
       )
     )
     )
   (entdel pl)
 )
 new
)

[olivier29]

merci tout le monde c'est nikel!!