Changer en masse le sens des Polylignes

[lecrabe]

 

Hello Gilles

 

Tu avais donné ici une excellente routine pour changer le sens des Polylignes

mais c'est UNE par UNE ...

(encore merci même si avec la 2010, nous avons enfin cette fonction)

http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=10953#pid

 

SVP je désire une routine "un peu différente" :

1 - Pouvoir sélectionner N Polylignes (Sélection AutoCAD classique en fait)

2 - Question : Sens Trigo ou Sens Normal (Idem Aiguilles de montre) T/S :

3 - Action ...

 

C pour du traitement de masse des polylignes closes

afin de les remettre "dans le droit chemin" !

 

Merci d'avance, Le Decapode

 

 

[(gile)]

Salut,

 

Quand tu parles de sens trigo ou horaire, c(est bien pour des polylignes fermées ?

Parce qu'avec des polylignes ouvertes, je ne vois pas bien ce que ça veux dire...

[(gile)]

J'ai essayé un truc avec les aires algébriques.

 

;; POLYDIR (gile)
;; Donne aux polylignes fermées sélectionnées
;; le sens spécifie (horaire ou trigonométrique)

(defun c:POLYDIR (/ cw fltr n ss pl cnt)
 (initget "Horaire Trigo")
 (or (setq cw (getkword "\nSens des polylinges ? [Horaire/Trigo] : "))
     (setq cw "Horaire")
 )
 (setq fltr '((0 . "LWPOLYLINE"))
       n    0
       cnt 0
 )
 (princ "\nSélectionnez les Polylignes ou :")
 (or (setq ss (ssget fltr)) (setq ss (ssget "_X" fltr)))
 (while (setq pl (ssname ss n))
   (setq aa (PlineAlgebArea pl)
         n  (1+ n)
   )
   (if (or (and (minusp aa) (= cw "Trigo")) (and (      (progn
       (reverse_pline pl)
       (setq cnt (1+ cnt))
     )
   )
 )
 (princ (strcat (itoa n) " polyligne(s) sélectionnée(s), " (itoa cnt) " inversée(s)"))
 (princ)
)

;;; R_PLINE -Gilles Chanteau-
;;; Inverse l'ordre de sommets d'une polyligne (2D, 3D ou optimisée)
;;; Toutes les propriétés de la polyligne sont conservées (arcs, largeurs ...)

;; Inverse l'ordre de sommets d'une lwpolyligne, d'une polyligne 2D ou 3D

(defun reverse_pline (ent / e_lst vtx v_lst p_lst l_vtx)
 (setq e_lst (entget ent))
 (cond
   ((= (cdr (assoc 0 e_lst)) "POLYLINE")
    (setq vtx (entnext ent))
    (while (= (cdr (assoc 0 (entget vtx))) "VERTEX")
      (setq v_lst (cons (entget vtx) v_lst)
            vtx   (entnext vtx)
      )
    )
   )
   ((= (cdr (assoc 0 e_lst)) "LWPOLYLINE")
    (setq p_lst (vl-remove-if-not '(lambda (x) (member (car x) '(10 40 41 42)))
                                  e_lst
                )
          e_lst (vl-remove-if '(lambda (x) (member x p_lst)) e_lst)
    )
    (while p_lst
      (setq v_lst (cons (list (car p_lst) (cadr p_lst) (caddr p_lst) (cadddr p_lst))
                        v_lst
                  )
            p_lst (member (assoc 10 (cdr p_lst)) (cdr p_lst))
      )
    )
   )
 )
 (setq l_vtx (last v_lst)
       l_vtx (subst (cons 40 (cdr (assoc 41 (car v_lst)))) (assoc 40 l_vtx) l_vtx)
       l_vtx (subst (cons 41 (cdr (assoc 40 (car v_lst)))) (assoc 41 l_vtx) l_vtx)
       l_vtx (subst (cons 42 (- (cdr (assoc 42 (car v_lst)))))
                    (assoc 42 l_vtx)
                    l_vtx
             )
 )
 (setq v_lst (mapcar '(lambda (x y)
                        (setq x (subst (cons 40 (cdr (assoc 41 y))) (assoc 40 x) x)
                              x (subst (cons 41 (cdr (assoc 40 y))) (assoc 41 x) x)
                              x (subst (cons 42 (- (cdr (assoc 42 y)))) (assoc 42 x) x)
                        )
                      )
                     v_lst
                     (cdr v_lst)
             )
 )
 (if (= (logand 1 (cdr (assoc 70 e_lst))) 1)
   (setq v_lst (append (list l_vtx) v_lst))
   (setq v_lst (append v_lst (list l_vtx)))
 )
 (cond ((= (cdr (assoc 0 e_lst)) "POLYLINE")
        (mapcar 'entmake (append (list e_lst) v_lst (list (entget vtx))))
        (entdel ent)
       )
       ((= (cdr (assoc 0 e_lst)) "LWPOLYLINE")
        (setq e_lst (append e_lst (apply 'append v_lst)))
        (entmod e_lst)
       )
 )
)

;; TriangleAlgebArea (gile)
;; Retourne l'aire algébrique du triangle défini par 3 points 2D
;; l'aire est négative si les points sont en sens horaire

(defun TriangleAlgebArea (p1 p2 p3)
 (/ (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
       (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))
    )
    2.0
 )
)

;; PolyarcAlgebArea (gile)
;; Retourne l'aire algébrique d'un polyarc,
;; négative si la courbure est en sens horaire
;;
;; Arguments
;; bu : la courbure du polyarc (bulge)
;; p1 : le sommet de départ
;; p2 : le sommet de fin

(defun PolyarcAlgebArea (bu p1 p2 / ang rad cen area)
 (setq ang  (* 2 (atan bu))
       rad  (/ (distance p1 p2) (* 2 (sin ang)))
       cen  (polar p1 (+ (angle p1 p2) (- (/ pi 2) ang)) rad)
       area (/ (* rad rad (- (* 2 ang) (sin (* 2 ang)))) 2.0)
 )
)

;; PlineAlgebArea (gile)
;; Retourne l'aire algébrique d'une polyligne
;;
;; Argument
;; pl : nom d'entité de la polyligne (ename)

(defun PlineAlgebArea (pl / elst lst area p0 area)
 (setq elst (entget pl))
 (while (setq elst (member (assoc 10 elst) elst))
   (setq lst  (cons (cons (cdar elst) (cdr (cadddr elst))) lst)
         elst (cdr elst)
   )
 )
 (setq lst  (reverse lst)
       area 0.0
       p0   (caar lst)
 )
 (if (/= 0 (cdar lst))
   (setq area (PolyarcAlgebArea (cdar lst) p0 (caadr lst)))
 )
 (setq lst (cdr lst))
 (if (equal (car (last lst)) p0 1e-9)
   (setq lst (reverse (cdr (reverse lst))))
 )
 (while (cadr lst)
   (setq area (+ area (TriangleAlgebArea p0 (caar lst) (caadr lst))))
   (if (/= 0 (cdar lst))
     (setq area (+ area (PolyarcAlgebArea (cdar lst) p0 (caadr lst))))
   )
   (setq lst (cdr lst))
 )
 (if (/= 0 (cdar lst))
   (setq area (+ area (PolyarcAlgebArea (cdar lst) p0 (caadr lst))))
 )
 area
)

[lecrabe]

 

 

Hello Gilles

 

J'ai testé sur un MAP 2008 avec un dessin de test ayant des polylignes closes plus ou moins torturées et surtout possédant des XDATA d'AutoCAD et AUSSI des Object Data de MAP ...

 

Cela semble bien marcher ! :)

C TIP-TOP, les XD et OD sont conservees ! :D

 

Si j'ai des polylignes non closes, je les isole par la selection rapide sur un autre calque ou je vais les clore, je lance ta routine dessus et apres je les re-ouvre ... :P

 

Par contre, SVP pourrais tu ajouter un petit truc :

Indiquer le nombre de polylignes closes que tu vas traiter

et aussi le nombre qui sont "renversees" apres traitement

 

Encore merci pour ta rapidite et ton efficacite :cool:

 

Le Decapode

 

 

[(gile)]

J'ai modifiée la routine.

 

Elle affiche le nombre de polyligne sélectionnées et le nombres de celles qui ont été inversées.

 

J'ai aussi supprimé le filtre sur les polylignes fermées, l'aire est donc calculée comme si on fermait la polyligne (comme le fait AutoCAD avec les objets "ouverts")

Attention toutefois si la fermeture de la polyligne génère un croisement (polygone croisé), c'est le sens de la polyligne sur les contour de la plus grande aire qui détermine si elle est en sens horaire ou trigo.

 

http://img35.imageshack.us/img35/9334/senspoly.png

 

Un petit LISP qui affiche le sens des polylignes (les flèches sont automatiquement supprimées à la régénération ou avec un zoom ou un pan.

 

(defun c:senspoly (/ ent n pt pt0 pt1 ang dis)
 (vl-load-com)
 (setq dis (/ (getvar "viewsize") 50))
 (if
   (and
     (setq ent (car (entsel)))
     (= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
   )
    (repeat (setq n (fix (vlax-curve-getEndParam ent)))
      (setq pt	 (trans (vlax-curve-getPointAtParam ent (- n 0.5)) 0 1)
     pt0 (trans (vlax-curve-getPointAtParam ent n) 0 1)
     pt1 (trans (vlax-curve-getPointAtParam ent (1- n)) 0 1)
     ang (angle pt0 pt1)
     n	 (1- n)
      )
      (grvecs (list 1
	     pt
	     (polar pt (- ang (/ pi 6)) dis)
	     1
	     pt
	     (polar pt (+ ang (/ pi 6)) dis)
       )
      )
    )
 )
 (princ)
)

[lecrabe]

 

Hello Gilles

 

Ca me semble toujours parfais sur un MAP 2008 ! :)

 

Merci, merci, tu vas au dela de mes desirs mais c dangeureux :)

car tu m'as donne des idees avec ta nouvelle routine SENSPOLY ! :exclam:

 

SVP je desire une version 1.1 de SENSPOLY qui puisse : :D

 

1) Traiter N polylignes et non pas une seule (en mode GRVECS)

si c'est possible ?

 

2) option Oui/Non pour dessiner reellement la fleche sur le calque courant

(et non pas un GRVECS)

On peut supposer qu'un bloc "fleche" dessine a l'horizontale vers la droite

et nomme FLECHE_DROITE doit exister !

et bien sur tu l'utilises pour le mettre au milieu de chaque segment (dans le bon sens)

 

3) option "de luxe" : ne pas inserer le bloc fleche si le segment a une longeur inferieure a xx.xx

(Question a poser au debut, si on desire le vrai dessin de la fleche)

 

Ainsi nous aurions des fleches seulement sur les segments "utiles" !

 

Je te salue bien bas, Oh grand Maitre du Lisp & V-Lisp & xxxxx

 

Le Decapode "retourneur de polylignes"

 

 

[lecrabe]

 

Hello Gilles

 

Ta routine SENSPOLY me turlupinait un peu beaucoup !?

et en effet tu avais deja developpe une routine SENSPOLY (28 Octobre 2008)

qui dessine un bloc de fleche soit sur chaque segment, soit au debut/fin ! :exclam:

 

Par contre SVP pourrais tu en faire une nouvelle version qui pose la question sur la longueur minimum du segment (a traiter) afin de ne dessiner ton bloc de fleche qur sur les segments dont la longueur est >= xx.xx

 

Si on a pris l'option Debut/Fin, on n'est pas concerné !

 

Merci d'avance, Le Decapode

 

[(gile)]

Salut,

 

Une autre version de SENSPOLY :

- les blocs : fleche_1, fleche_deb et flech_fin doivent être présent dans le dessin ou dans les chemins de recherche

- l'utilisateur choisit une option : "Extrémités" ou "Tous les segments"

- si l'option choisie est "T" (defaut), l'utilisateur spécifie la longueur minimale des segments (défaut [surligneur]50.0[/surligneur] modifiable dans le code)

- l'utilisateur sélectionne les polylignes à traiter ou valide pour toutes les polylignes

- les blocs sont insérés sur le calque courant.

 

(defun c:senspoly (/ *error* space opt ss par f1 fd ff)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (defun *error* (msg)
   (or (= msg "Fonction annulée")
       (princ (strcat "\nErreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )
 (setq	space (if (= 1 (getvar "CVPORT"))
	(vla-get-PaperSpace *acdoc*)
	(vla-get-ModelSpace *acdoc*)
      )
 )
 (or (tblsearch "BLOCK" (setq f1 "fleche_1"))
     (findfile (setq f1 "fleche_1.dwg"))
     (setq f1 nil)
 )
 (or (tblsearch "BLOCK" (setq fd "fleche_deb"))
     (findfile (setq fd "fleche_deb.dwg"))
     (setq fd nil)
 )
 (or (tblsearch "BLOCK" (setq ff "fleche_fin"))
     (findfile (setq ff "fleche_fin.dwg"))
     (setq ff nil)
 )
 (cond
   ((not f1) (princ "\nLe bloc \"Fleche_1\" est introuvable."))
   ((not fd) (princ "\nLe bloc \"Fleche_deb\" est introuvable."))
   ((not ff) (princ "\nLe bloc \"Fleche_fin\" est introuvable."))
   (T
    (initget "Tous les segments Extrémités")
    (if (not (setq opt
	     (getkword
	       "\nChoisissez une option [Tous les segments/Extrémités] : "
	     )
      )
 )
      (setq opt "Tous")
    )
    (if (= opt "Tous")
      (or (setq lmin (getdist "\nLongueur minimale des segments : "))
          (setq lmin 40.0)
      )
    )
    (princ "\nSélectionnez les polylignes ou : ")
    (or (setq ss (ssget (list '(0 . "LWPOLYLINE"))))
 (setq ss
	(ssget "_X"
	       (list '(0 . "LWPOLYLINE") (cons 410 (getvar "CTAB")))
	)
 )
    )
    (if ss
      (progn
 (vla-StartUndoMark *acdoc*)
 (vlax-for pl (setq ss (vla-get-ActiveSelectionSet *acdoc*))
   (setq par (vlax-curve-getEndParam pl))
   (if (= opt "Tous")
     (while (               (if (                       (- (vlax-curve-getDistAtParam pl par)
                         (vlax-curve-getDistAtParam pl (1- par))
                      )
                  )
                (progn
                  (setq par (- par 0.5))
                  (vla-InsertBlock
                    space
                    (vlax-3d-point
                      (vlax-curve-getPointAtParam pl par)
                    )
                    f1
                    1.0
                    1.0
                    1.0
                    (angle '(0.0 0.0 0.0)
                           (vlax-curve-getFirstDeriv pl par)
                    )
                  )
                  (setq par (- par 0.5))
                )
                (setq par (1- par))
              )
            )
     (progn
       (vla-InsertBlock
	 space
	 (vlax-3d-point
	   (vlax-curve-getPointAtParam pl par)
	 )
	 ff
	 1.0
	 1.0
	 1.0
	 (angle	'(0.0 0.0 0.0)
		(vlax-curve-getFirstDeriv pl (- par 1e-9))
	 )
       )
       (vla-InsertBlock
	 space
	 (vlax-3d-point
	   (vlax-curve-getPointAtParam pl 0)
	 )
	 fd
	 1.0
	 1.0
	 1.0
	 (angle	'(0.0 0.0 0.0)
		(vlax-curve-getFirstDeriv pl 0)
	 )
       )
     )
   )
 )
 (vla-delete ss)
 (vla-EndUndoMark *acdoc*)
      )
    )
   )
 )
 (princ)
)

[lili2006]

Bonjour à toutes et tous,

 

Comment doivent-être dessinés les flèches "fleche_1, fleche_deb et flech_fin" ?

 

Merci d'avance,

[(gile)]

Comment doivent-être dessinés les flèches "fleche_1, fleche_deb et flech_fin" ?

 

La "flèche" doit être orientée suivant l'axe X avec la pointe vers les X positifs, après le bloc peut être fait à la convenance de chacun (forme, points d'insertion ...)

 

Un exemple de blocs constitués d'un segment de polyligne à largeur variable, avec des points d'insertion différents :

http://img525.imageshack.us/img525/9746/fleche.png

[lili2006]

Re,

 

Ok !

 

Merci de ces précisions, je vais tester en début d'AM,...

 

 

[lili2006]

Rere,

 

Marche super bien !

 

Très pratique également en VRD pour le sens d'écoulement des différents fluides,.. (Si on à pas covadis !)

 

Merci Gilles, :D

[dilack]

salut a tous,

Voici ce que ca donne sous AutoCAD 2010????? avec les option suivant:

 

Commande: SENSPOLY

Choisissez une option [Tous les segments/Extrémités] :

Longueur minimale des segments <1.0>: 2

Sélectionnez les polylignes ou :

Choix des objets: 1 trouvé(s)

 

http://images.imagehotel.net/pfv3mfs9ei.jpeg

 

 

[(gile)]

Salut dilack,

 

Ça me semble tout à fait normal si tu as sélectionné un polyligne n'ayant qu'un segment.

[dilack]

salut gille

je voulais simplement avoir la confirmation car avec la version 2010 certain lisp ne fonctionne pas correctement.

[dilack]

re re,

une petite question est-il possible insérer d'une façon incrémenté les flèche, c'est à dire de les insérer comme exemple tous les 1m.

[(gile)]

Oui, avec la commande MESURER (_MEASURE) Option "Bloc", Aligner avec l'objet: "Oui"