[ RÉSOLU] Sens de parcours des polylignes (Horaire ou anti-horaire)

[TUAU]

Bonjours les LISPiens,

Je voudrais trouver un LISP qui puisse gérer automatiquement le sens de parcours des polylignes suivant leurs localisations. 

Toutes polylignes fermées internes à une autres de même calque doit être de sens de parcours anti-horaire et que la polyligne circonscrite doit être de sens de parcours horaire.

Ceci me sera utile pour le traitement d'habillage automatique des calques des différents végétations.

Déroulement des manipes souhaités :

• invite "sélection de polyligne" ou choisir le calque à traiter?
• on fait une sélection classique autocad
•  Clore les polylignes et les mettre aux sens de parcours horaires
• Détecter les polylignes fermées internes à d'autres
• mettre ces derniers dans le sens de parcours anti-horaire.

Merci d'avance pour votre aide.

JM

Sens de parcours polylignes.dwg

[Olivier Eckmann]

Bonjour,

 

Quelques liens vers des lisp permettant de savoir si une polyligne est en sens horaire ou anti-horaire : 

https://www.cadtutor.net/forum/topic/47024-lsp-to-set-multiple-polygons-direction-to-clockwise/?do=findComment&comment=385237

https://forums.augi.com/showthread.php?6678-Clockwise-Anti-clockwise-Polyline

 

Olivier

[(gile)]

Salut,

On devrait pouvoir s'inspirer de ce sujet.

[(gile)]

;; plineSignedArea
;; Obtient l'aire algébrique (signée) de la polyligne
(defun plineSignedArea (pline / triangleArea arcArea elst lst area p0)

  (defun triangleArea (p1 p2 p3)
    (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
       (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))
    )
  )

  (defun arcArea (p1 p2 bulge / ang rad)
    (setq ang (* 2 (atan bulge))
	  rad (/ (distance p1 p2) (* 2 (sin ang)))
    )
    (* rad rad (- (* 2 ang) (sin (* 2 ang))))
  )

  (setq elst (entget pline))
  (while (setq elst (member (assoc 10 elst) elst))
    (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
	  elst (cdr elst)
    )
  )
  (setq	lst  (reverse lst)
	area 0.0
	p0   (caar lst)
  )
  (if (/= 0 (cdar lst))
    (setq area (arcArea p0 (caadr lst) (cdar 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 (triangleArea p0 (caar lst) (caadr lst))))
    (if	(/= 0 (cdar lst))
      (setq area (+ area (arcArea (caar lst) (caadr lst) (cdar lst))))
    )
    (setq lst (cdr lst))
  )
  (if (/= 0 (cdar lst))
    (setq area (+ area (arcArea (caar lst) p0 (cdar lst))))
  )
  (/ area 2.)
)

;; isClockwise
;; Evalue si la polyligne est en sens horaire
(defun isClockwise (pline) (minusp (plineSignedArea pline)))

;; reversePline
;; Inverse l'ordre des sommets de la polyligne
(defun reversePline (ent / split dxfLst vrtxLst lastVrtx)
  
  (defun split (l)
    (if	l
      (cons (list (car l) (cadr l) (caddr l) (cadddr l))
	    (split (cddddr l))
      )
    )
  )
  
  (setq dxfLst (entget ent))
  (setq	vrtxLst (reverse
	       (split
		 (vl-remove-if-not
		   '(lambda (x) (member (car x) '(10 40 41 42)))
		   dxfLst
		 )
	       )
	     )
	dxfLst (vl-remove-if
	       '(lambda (x) (member (car x) '(10 40 41 42)))
	       dxfLst
	     )
  )
  (setq	lastVrtx (last vrtxLst)
	lastVrtx (subst (cons 40 (cdr (assoc 41 (car vrtxLst))))
		    (assoc 40 lastVrtx)
		    (subst (cons 41 (cdr (assoc 40 (car vrtxLst))))
			   (assoc 41 lastVrtx)
			   (subst (cons 42 (- (cdr (assoc 42 (car vrtxLst)))))
				  (assoc 42 lastVrtx)
				  lastVrtx
			   )
		    )
	     )
  )
  (setq	vrtxLst (mapcar '(lambda (x y)
			(setq
			  x (subst (cons 40 (cdr (assoc 41 y)))
				   (assoc 40 x)
				   (subst (cons 41 (cdr (assoc 40 y)))
					  (assoc 41 x)
					  (subst (cons 42 (- (cdr (assoc 42 y))))
						 (assoc 42 x)
						 x
					  )
				   )
			    )
			)
		      )
		     vrtxLst
		     (cdr vrtxLst)
	     )
  )
  (if (= (logand 1 (cdr (assoc 70 dxfLst))) 1)
    (setq vrtxLst (append (list lastVrtx) vrtxLst))
    (setq vrtxLst (append vrtxLst (list lastVrtx)))
  )
  (setq dxfLst (append dxfLst (apply 'append vrtxLst)))
  (entmod dxfLst)
)

;; massoc
;; renvoie la liste de toutes les valeurs pour la clé spécifiée
(defun massoc (key alst)
  (if (setq alst (member (assoc key alst) alst))
    (cons (cdar alst) (massoc key (cdr alst)))
  )
)

;; Commande de test
(defun c:test (/ ss1 i pline ss2 j)
  ;; invite "sélection de polyligne"
  ;; on fait une sélection classique autocad
  (if (setq ss1 (ssget '((0 . "LWPOLYLINE"))))
    (repeat (setq i (sslength ss1))
      (setq pline (ssname ss1 (setq i (1- i))))
      ;; Clore les polylignes et les mettre aux sens de parcours horaires
      (if (zerop (getpropertyvalue pline "Closed"))
	(setpropertyvalue pline "Closed" 1)
      )
      (if (not (IsClockwise pline))
	(reversePline pline)
      )
      ;; Détecter les polylignes fermées internes à d'autres
      (if (setq	ss2 (ssget "_WP"
			   (massoc 10 (entget pline))
			   '((0 . "LWPOLYLINE"))
		    )
	  )
	(repeat	(setq j (sslength ss2))
	  (setq pline (ssname ss2 (setq j (1- j))))
	  ;; mettre ces derniers dans le sens de parcours anti-horaire.
	  (if (IsClockwise pline)
	    (reversePline pline)
	  )
	)
      )
    )
  )
  (princ)
)

 

[TUAU]

Bonjour a tous

Merci Olivier Eckmann ; (gile) de vous êtes penchez sur mon souhait.

je vous laisse imaginer à quel niveau de satisfaction je suis en ce moment après avoir tester le programme à (gile); moi le découvreur (niveau zéro) du LISP.

MR (gile)J'ai copié votre programme dans un fichier texte et l'ai téléchargé depuis Autocad Map 3d 2022 avec la commande APPLOAD.

Puis j'ai lancé le programme avec la commande TEST, sélectionné les polylignes et taper ENTRER.

Le Résultat est que tous les polylignes sont dans le sens horaires.

Ce qui parfait pour ce que j'attendais mais si possible d'aller encore plus loin en retrouvant des polylignes fermés internes à une autre et les mettre dans le sens "anti-horaire".

En PJ j'ai essayé d'illustrer mon souhait dans un dwg .

 

Bon courage à vous!

JMT

 

 

Sens de parcours polylignes.dwg

[(gile)]

Salut,

J'avais mal compris la demande, je pensais qu'on ne sélectionnait que les polylignes en contenant d'autres.

Partir de toutes les polylignes et les trier suivant qu'elles sont à l'intérieur d'une autre ou pas n'est pas une chose simple.

 

[Olivier Eckmann]

Bonjour,

 

Si tu as un AutoCAD Map, tu peux tenter le coup avec les MPolygones.

Tu lances la commande MPOLYGON, puis Entrée pour passer en mode choix des objets, puis tu sélectionnes toutes tes polylignes et tu valides la transformation.

Automatiquement les polylignes internes seront détectées et déduites des contours externes englobants.

Tu supprimes les polylignes originales, puis tu décomposes tous les MPolygones.

Tu obtiens à nouveau tes polylignes, les externes (englobantes) tournent en sens trigo et les poly internes (ilôts) tournent en sens horaire.

Il te suffit alors d'inverser le sens de toutes tes polylignes : PEDIT MULTIPLE INVERSER

 

Olivier

[lecrabe]

Hello @Olivier Eckmann

Olivier tu es GENIAL, j avais completement oublie CE DETAIL des MPolygones !

Bonne Journee, La Sante, Bye, lecrabe

 

[lecrabe]

Hello @(gile)

J adore ton Lisp sur les LWPLines !

SVP puis je te demander qq petites ameliorations :

-- Poser la Question Sens Horaire (Defaut ou Sens Anti-Horairre)

( OK on peut aussi passer APRES par un PEDITM ... Inverser ... )

-- Traiter les PLines 2D Legeres ET Lourdes

NOTE 1 : BRAVO car les XDATAs et ODs (Object Data de MAP) sont conservees !

NOTE 2 : j ai remarque que si les LWPLines ne sont pas Closes / Fermees alors ta Routine s en occupe !?

Merci, Bye, lecrabe

 

[(gile)]

Cette version devrait répondre à la demande de @TUAU.

;; plineSignedArea
;; Obtient l'aire algébrique (signée) de la polyligne
(defun plineSignedArea (pline / triangleArea arcArea elst lst area p0)

  (defun triangleArea (p1 p2 p3)
    (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
       (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))
    )
  )

  (defun arcArea (p1 p2 bulge / ang rad)
    (setq ang (* 2 (atan bulge))
	  rad (/ (distance p1 p2) (* 2 (sin ang)))
    )
    (* rad rad (- (* 2 ang) (sin (* 2 ang))))
  )

  (setq elst (entget pline))
  (while (setq elst (member (assoc 10 elst) elst))
    (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
	  elst (cdr elst)
    )
  )
  (setq	lst  (reverse lst)
	area 0.0
	p0   (caar lst)
  )
  (if (/= 0 (cdar lst))
    (setq area (arcArea p0 (caadr lst) (cdar 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 (triangleArea p0 (caar lst) (caadr lst))))
    (if	(/= 0 (cdar lst))
      (setq area (+ area (arcArea (caar lst) (caadr lst) (cdar lst))))
    )
    (setq lst (cdr lst))
  )
  (if (/= 0 (cdar lst))
    (setq area (+ area (arcArea (caar lst) p0 (cdar lst))))
  )
  (/ area 2.)
)

;; isClockwise
;; Evalue si la polyligne est en sens horaire
(defun isClockwise (pline) (minusp (plineSignedArea pline)))

;; reversePline
;; Inverse l'ordre des sommets de la polyligne
(defun reversePline (ent / split dxfLst vrtxLst lastVrtx)
  
  (defun split (l)
    (if	l
      (cons (list (car l) (cadr l) (caddr l) (cadddr l))
	    (split (cddddr l))
      )
    )
  )
  
  (setq dxfLst (entget ent))
  (setq	vrtxLst (reverse
	       (split
		 (vl-remove-if-not
		   '(lambda (x) (member (car x) '(10 40 41 42)))
		   dxfLst
		 )
	       )
	     )
	dxfLst (vl-remove-if
	       '(lambda (x) (member (car x) '(10 40 41 42)))
	       dxfLst
	     )
  )
  (setq	lastVrtx (last vrtxLst)
	lastVrtx (subst (cons 40 (cdr (assoc 41 (car vrtxLst))))
		    (assoc 40 lastVrtx)
		    (subst (cons 41 (cdr (assoc 40 (car vrtxLst))))
			   (assoc 41 lastVrtx)
			   (subst (cons 42 (- (cdr (assoc 42 (car vrtxLst)))))
				  (assoc 42 lastVrtx)
				  lastVrtx
			   )
		    )
	     )
  )
  (setq	vrtxLst (mapcar '(lambda (x y)
			(setq
			  x (subst (cons 40 (cdr (assoc 41 y)))
				   (assoc 40 x)
				   (subst (cons 41 (cdr (assoc 40 y)))
					  (assoc 41 x)
					  (subst (cons 42 (- (cdr (assoc 42 y))))
						 (assoc 42 x)
						 x
					  )
				   )
			    )
			)
		      )
		     vrtxLst
		     (cdr vrtxLst)
	     )
  )
  (if (= (logand 1 (cdr (assoc 70 dxfLst))) 1)
    (setq vrtxLst (append (list lastVrtx) vrtxLst))
    (setq vrtxLst (append vrtxLst (list lastVrtx)))
  )
  (setq dxfLst (append dxfLst (apply 'append vrtxLst)))
  (entmod dxfLst)
)

;; massoc
;; Renvoie la liste de toutes les valeurs pour la clé spécifiée
(defun massoc (key alst)
  (if (setq alst (member (assoc key alst) alst))
    (cons (cdar alst) (massoc key (cdr alst)))
  )
)

;; Commande de test
(defun c:test (/ ss i pline plines ccwPlines)
  ;; invite "sélection de polyligne"
  ;; on fait une sélection classique autocad
  (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
    (progn
      (repeat (setq i (sslength ss))
	(setq pline (ssname ss (setq i (1- i))))
	;; Clore les polylignes et les mettre aux sens de parcours horaires
	(if (zerop (getpropertyvalue pline "Closed"))
	  (setpropertyvalue pline "Closed" 1)
	)
	(setq plines (cons pline plines))
      )
      ;; Détecter les polylignes fermées internes à d'autres
      (command-s "_.zoom" "_extents")
      (foreach pline plines
	(if (setq ss (ssget "_WP"
			    (massoc 10 (entget pline))
			    '((0 . "LWPOLYLINE"))
		     )
	    )
	  (repeat (setq i (sslength ss))
	    (setq ccwPlines (cons (ssname ss (setq i (1- i))) ccwPlines))
	  )
	)
      )
      (command-s "_.zoom" "_previous")
      ;; Attribuer le sens des polylignes
      (foreach pline plines
	(if (member pline ccwPlines)
	  (if (IsClockwise pline)
	    (reversePline pline)
	  )
	  (if (not (IsClockwise pline))
	    (reversePline pline)
	  )
	)
      )
    )
  )
  (princ)
)

 

[(gile)]

Il y a 4 heures, lecrabe a dit :

-- Poser la Question Sens Horaire (Defaut ou Sens Anti-Horairre)

Ce n'est plus du tout la demande initiale dans laquelle le sens est déterminé par le fait que la polyligne soit "interne" ou "externe".

 

Il y a 4 heures, lecrabe a dit :

NOTE 2 : j ai remarque que si les LWPLines ne sont pas Closes / Fermees alors ta Routine s en occupe !?

C'est dans la demande initiale. De toutes façons sens horaire/anti-horaire n'a de sens que si la polyligne est fermée.

[lecrabe]

Hello @(gile) 

1) OK : ... PEDITM ... Inverser ...

2) Pas de souci, je marquerai par une couleur FORCEE les Polylignes "ouvertes" pour les corriger apres ...

3) Et traiter aussi les Polylignes "lourdes", c complique ??

Merci, Bye, lecrabe

 

[TUAU]

Hello les KINGs

Je ne sais comment vous remercier mais je vous souhaite de tout mon âme une bonne santé et longue vie à vous afin de continuer à faire du chaud dans les cœurs des demandeurs de routines LISP.

Je te salut bien bas MR @gile depuis la nouvelle calédonie.

🙏👋

[TUAU]

  

Le 15/02/2024 à 09:59, TUAU a dit :

Bonjour Mr @gile je suis vraiment désolé  mais j'avais omis un détail très important lors de ma demande; c'est que mon fichier DWG est en 3D.

Comme j'ai un souci en ce moment avec covadis, j'avais fait les test sut autocad en utilisant des polylignes 2d.

En 2D tout roule !!!! mais à ma  grande surprise lors de l'exécution sur le fichier 3D; lors de la sélection des polylignes il trouve 0 objets.

Et en dessinant sur le côté des polylignes 2D et relancer la routines; il les retrouve bien. 

Est-ce compliqué de faire la même routine avec des polylignes 3D? 

Merci beaucoup!

 

Il y a 16 heures, (gile) a dit :

Salut,

Les notions de sens horaire ou anti-horaire n'ont de sens qu'en 2D, c'est à dire avec des objets plans et la normale du plan qui défini la direction dans laquelle on "regarde" l'objet.

Si les polylignes 3D sont planes et contenues dans le même plan, il devrait être possible de quelque chose (mais dans ce cas pourquoi utiliser des polylignes 3D ?).

Ok Merci a vous!

Sinon pour parlier à ce souci de 3D.

ce serait possible de modifier votre lisp 2D pour pouvoir afficher des mini flèches (dans un calque "MF" par exemple) sur les  polylignes qui ont un sens anti-horraire et de mettre tous les polylignes internes dans une couleur autres que "ducalque".

l'idée est que je mettrai une copie en 2d  et avec votre moulinette j'aurais un support visuel pour corriger mon fichier 3d.

un petit dwg récapitulatif en pj!

Olé!!

 

 

Sens de parcours polylignes.dwg

[(gile)]

Ça devrait répondre à la demande.

;; massoc
;; Renvoie la liste de toutes les valeurs pour la clé spécifiée
(defun massoc (key alst)
  (if (setq alst (member (assoc key alst) alst))
    (cons (cdar alst) (massoc key (cdr alst)))
  )
)
;; plineSignedArea
;; Obtient l'aire algébrique (signée) de la polyligne
(defun plineSignedArea (pline / triangleArea arcArea elst lst area p0)

  (defun triangleArea (p1 p2 p3)
    (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
       (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))
    )
  )

  (defun arcArea (p1 p2 bulge / ang rad)
    (setq ang (* 2 (atan bulge))
	  rad (/ (distance p1 p2) (* 2 (sin ang)))
    )
    (* rad rad (- (* 2 ang) (sin (* 2 ang))))
  )

  (setq elst (entget pline))
  (while (setq elst (member (assoc 10 elst) elst))
    (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
	  elst (cdr elst)
    )
  )
  (setq	lst  (reverse lst)
	area 0.0
	p0   (caar lst)
  )
  (if (/= 0 (cdar lst))
    (setq area (arcArea p0 (caadr lst) (cdar 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 (triangleArea p0 (caar lst) (caadr lst))))
    (if	(/= 0 (cdar lst))
      (setq area (+ area (arcArea (caar lst) (caadr lst) (cdar lst))))
    )
    (setq lst (cdr lst))
  )
  (if (/= 0 (cdar lst))
    (setq area (+ area (arcArea (caar lst) p0 (cdar lst))))
  )
  (/ area 2.)
)

;; isClockwise
;; Evalue si la polyligne est en sens horaire
(defun isClockwise (pline) (minusp (plineSignedArea pline)))

;; makeArrowBlock
;; Crée le bloc "CwArrow" s'il n'existe pas
(defun makeArrowBlock ()
  (if (null (tblsearch "BLOCK" "CwArrow"))
    (progn
      (entmakex
	'((0 . "BLOCK") (2 . "CwArrow") (70 . 0) (10 0.0 0.0 0.0))
      )
      (entmakex
	'((0 . "LWPOLYLINE")
	  (100 . "AcDbEntity")
	  (8 . "0")
	  (100 . "AcDbPolyline")
	  (90 . 7)
	  (70 . 129)
	  (10 -25.0 -2.5)
	  (10 0.0 -2.5)
	  (10 0.0 -12.5)
	  (10 25.0 0.0)
	  (10 0.0 12.5)
	  (10 0.0 2.5)
	  (10 -25.0 2.5)
	 )
      )
      (entmakex '((0 . "ENDBLK")))
    )
  )
)

;; insertArrowBlock
;; Insère le bloc "CwArrow"
(defun insertArrowBlock	(position rotation)
  (entmakex
    (list
      (cons 0 "INSERT")
      (cons 100 "AcDbEntity")
      (cons 100 "AcDbBlockReference")
      (cons 2 "CwArrow")
      (cons 10 position)
      (cons 50 rotation)
    )
  )
)

;; midPoint
;; renvoie le milieu de deux points
(defun midPoint (pt1 pt2)
  (mapcar (function (lambda (x1 x2) (/ (+ x1 x2) 2.))) p1 p2)
)

;; insertArrowOnPline
;; Insère le bloc "CwArrow" sur chaque segment de la polyligne
(defun insertArrowOnPline (pline / pts)
  (makeArrowBlock)
  (setq	pts (massoc 10 (entget pline))
	lst (mapcar
	      (function
		(lambda	(p1 p2)
		  (list (midPoint p1 p2) (angle p1 p2))
		)
	      )
	      pts
	      (append (cdr pts) (list (car pts)))
	    )
  )
  (foreach p lst (apply 'insertArrowBlock p))
)

;; Commande de test
(defun c:test (/ ss1 i pline ss2 j)
  (if (setq ss1 (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))
    (progn
      (command-s "_.zoom" "_extents")
      (repeat (setq i (sslength ss1))
	(setq pline (ssname ss1 (setq i (1- i))))
	(if (not (IsClockwise pline))
	  (insertArrowOnPline pline)
	)
	(if (setq ss2 (ssget "_WP"
			    (massoc 10 (entget pline))
			    '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))
		     )
	    )
	  (repeat (setq j (sslength ss2))
	    (setpropertyvalue (ssname ss2 (setq j (1- j))) "Color" "5")
	  )
	)
      )
      (command-s "_.zoom" "_previous")
    )
  )
  (princ)
)

 

[TUAU]

Bonjour à Vous @gile,

Tout est parfait.

Avant j'avais rien d'autre que regarder élément par élément pour avoir un fichier clean.

Et là Houpssss Une consultation chez DOCTEUR @gile et en moins de 1mn j'avais les éléments à corriger ciblés.

 

Merciiiiiiiiiiiiiii à vous depuis la Nouvelle Calédonie.🙏💪

[TUAU]

Bonjour à Vous @gile,

vous pourriez Tester votre lisp sur le fichier en PJ et me dire s'il prend bien l'ensemble des polylignes car avec moi il ne traite qu'une partie de mes polylignes.

j'étais obligé de refaire de petite zone de capture de sélection pour traiter l'ensemble du fichier.

Merci 

Sens de parcours polylignes.dwg

[(gile)]

Le problème ne vient pas du code LISP mais des limites d'AutoCAD quand on veut traiter avec un LISP plus de 2000 polylignes d'un seul coup en insérant un bloc sur chaque segment quand certaines polylignes ont plusieurs milliers de sommets et, dans le même temps, de détecter des ilots.

Je te propose d'alléger un peu la tâche en séparant les deux traitement et en remplaçant l'insertion de dizaines de milliers de flèches par un simple changement de couleur.

Edit : La détection de polylignes "intérieures" provoque une "erreur matérielle" : "limite de la pile interne atteinte (simulation)" avec certaines polylignes ayant "trop de sommets".

;; Met en couleur orange (30) les polylignes fermées en sens anti-horaire.
(defun c:SENSPOLY (/ ss i pline)
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))
    (progn
      (repeat (setq i (sslength ss))
	(setq pline (ssname ss (setq i (1- i))))
	(if (not (IsClockwise pline))
	  (setpropertyvalue pline "Color" "30"); couleur orange "30"
	)
      )
    )
  )
  (princ)
)

 

[lecrabe]

Hello @TUAU

Pour completer la proposition de notre Grand Maitre @(gile)

Je te propose un Type de Ligne "SENS_ISOCP" qui dessine une Fleche dans le sens de construction des Polylignes, Lignes, Arcs, etc ...

;; 
;; Pour indiquer le sens de Saisie des Lignes / Polylignes / etc ... 
;; 
;; Ainsi avec ce type de ligne "SENS_ISOCP", on visualise le sens de Dessin / Numerisation des Polylignes ! 
;; 
;; C est tres interessant pour les Reseaux Gravitaires 
;; 

*SENS_ISOCP, SENS_ISOCP --->--->--->--- 
A,5,[">",ISOCP,S=2,X=-0.5,Y=-0.700],5
 

ATTENTION : tu dois avoir un Style de Texte nomme imperativement "ISOCP" qui utilise par exemple "ISOCP.SHX" dans ton DWG ! 

Ne pas hesiter a augmenter la Propriete "Echelle de type de ligne local" ...

 

RAPPEL : le fait d utiliser une Police SHX et non pas TTF dans les Types de Ligne permet d avoir des milliers d objets avec ce genre de Type de Ligne !

 

Bye, lecrabe

 

 

[(gile)]

En fait il y a un problème avec la "détection d'ilots" telle qu'elle est faite avec une sélection par fenêtre polygonales et certaines polylignes qui ont un nombre de sommets qui dépasse la limite.

Je ne suis pas sûr qu'il soit possible de contourner ce problème en LISP.

[TUAU]

Il y a 13 heures, (gile) a dit :

Le problème ne vient pas du code LISP mais des limites d'AutoCAD quand on veut traiter avec un LISP plus de 2000 polylignes d'un seul coup en insérant un bloc sur chaque segment quand certaines polylignes ont plusieurs milliers de sommets et, dans le même temps, de détecter des ilots.

Je te propose d'alléger un peu la tâche en séparant les deux traitement et en remplaçant l'insertion de dizaines de milliers de flèches par un simple changement de couleur.

Edit : La détection de polylignes "intérieures" provoque une "erreur matérielle" : "limite de la pile interne atteinte (simulation)" avec certaines polylignes ayant "trop de sommets".

;; Met en couleur orange (30) les polylignes fermées en sens anti-horaire.
(defun c:SENSPOLY (/ ss i pline)
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))
    (progn
      (repeat (setq i (sslength ss))
	(setq pline (ssname ss (setq i (1- i))))
	(if (not (IsClockwise pline))
	  (setpropertyvalue pline "Color" "30"); couleur orange "30"
	)
      )
    )
  )
  (princ)
)

 

ce lisp me conviendrais parfaitement (mettre d'une couleur les polyligne au sens anti-horaire).

ton mini lsp me donne un message d'erreur ( ; erreur: no function definition: ISCLOCKWISE )

Merci da vous d'être réactif sur mon souci.

 

[(gile)]

Il faut que les fonctions plineSignedArea et isClockwise soient aussi chargée.

Le code complet:

;; massoc
;; Renvoie la liste de toutes les valeurs pour la clé spécifiée
(defun massoc (key alst)
  (if (setq alst (member (assoc key alst) alst))
    (cons (cdar alst) (massoc key (cdr alst)))
  )
)
;; plineSignedArea
;; Obtient l'aire algébrique (signée) de la polyligne
(defun plineSignedArea (pline / triangleArea arcArea elst lst area p0)

  (defun triangleArea (p1 p2 p3)
    (- (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
       (* (- (car p3) (car p1)) (- (cadr p2) (cadr p1)))
    )
  )

  (defun arcArea (p1 p2 bulge / ang rad)
    (setq ang (* 2 (atan bulge))
	  rad (/ (distance p1 p2) (* 2 (sin ang)))
    )
    (* rad rad (- (* 2 ang) (sin (* 2 ang))))
  )

  (setq elst (entget pline))
  (while (setq elst (member (assoc 10 elst) elst))
    (setq lst  (cons (cons (cdar elst) (cdr (assoc 42 elst))) lst)
	  elst (cdr elst)
    )
  )
  (setq	lst  (reverse lst)
	area 0.0
	p0   (caar lst)
  )
  (if (/= 0 (cdar lst))
    (setq area (arcArea p0 (caadr lst) (cdar 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 (triangleArea p0 (caar lst) (caadr lst))))
    (if	(/= 0 (cdar lst))
      (setq area (+ area (arcArea (caar lst) (caadr lst) (cdar lst))))
    )
    (setq lst (cdr lst))
  )
  (if (/= 0 (cdar lst))
    (setq area (+ area (arcArea (caar lst) p0 (cdar lst))))
  )
  (/ area 2.)
)

;; isClockwise
;; Evalue si la polyligne est en sens horaire
(defun isClockwise (pline) (minusp (plineSignedArea pline)))

;; Met en couleur orange (30) les polylignes fermées en sens anti-horaire.
(defun c:SENSPOLY (/ ss i pline)
  (if (setq ss (ssget '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))))
    (progn
      (repeat (setq i (sslength ss))
	(setq pline (ssname ss (setq i (1- i))))
	(if (not (IsClockwise pline))
	  (setpropertyvalue pline "Color" "30"); couleur orange "30"
	)
      )
    )
  )
  (princ)
)

 

[TUAU]

WHAOUUUUUU, Millepécable.

hello @gile En PJ un de tes lisp où j'ai supprimer quelques lignes pour qu'il puisse identifier les polygones interne en leur mettant une couleur bleu seulement et ne plus inserer des blocs "CwArrow".

il fonctionne sur quelques polygones mais quand je le test sur le fichier ci-dessus, il zap beaucoup de polygones interne .

moyen d'y jeter un coup d'œil. merci 

l'autre fichier en PJ est ton original.

je veux exactement le même lisp qui colorie en orange mais seulement il faudra qu' il ne prend en compte que les polygones internes et qui les mettraient dans la couleur bleu.

polygone_internecouleurfleche(identcouleur).lsp polygoneinternecouleur(idinterncouleur).lsp

[(gile)]

Comme expliqué plus haut, la détection de polygones internes n'est pas fiable sur de tels fichiers avec des polylignes ayant plusieurs milliers de sommets.

Tu peux essayer sur ton fichier la routine ci-dessous.
Elle demande de sélectionner une seule polyligne pour détecter les polylignes internes et les mettre en bleu.
Tu constateras que, suivant la polyligne sélectionnée :
- parfois ça fonctionne comme espéré,
- parfois ça ne détecte pas les polylignes internes,
- parfois ça déclenche une erreur: "Une erreur matérielle s'est produite *** limite de la pile interne atteinte (simulation)"
 

(defun c:ILOTS (/ pl elst pts ss i)
  (if
    (and
      (setq pl (car (entsel "\nSélectinnez une polyligne: ")))
      (setq elst (entget pl))
      (= (cdr (assoc 0 elst)) "LWPOLYLINE")
    )
     (progn
       (command-s "_.zoom" "_object" pl "")
       (setq pts (massoc 10 elst))
       (if (setq ss (ssget "_WP" pts))
	 (repeat (setq i (sslength ss))
	   (setpropertyvalue (ssname ss (setq i (1- i))) "Color" "5")
	 )
       )
       (command-s "_.zoom" "_previous")
     )
  )
  (princ)
)

 

[(gile)]

Une version qui utilise un calcul géométrique plutôt que la sélection polygonale pour détecter les "ilots".
Elle détecte bien tous les "ilots" mais elle génère toujours une erreur sur certaines polylignes (CF fichier joint).
Mais il faut être patient, le traitement est plus long.

(defun c:DETECTILOTS (/
		      massoc
		      isPtInside
		      bbox
		      isInsideBbox
		      pl
		      elst
		      pts
		      minPt
		      maxPt
		      ss
		      i
		     )

  (defun massoc	(key alst)
    (if	(setq alst (member (assoc key alst) alst))
      (cons (cdar alst) (massoc key (cdr alst)))
    )
  )

  (defun isPtInside (pt pts / r)
    (mapcar
      '(lambda (p1 p2)
	 (if
	   (and
	     (/= (< (cadr pt) (cadr p1)) (< (cadr pt) (cadr p2)))
	     (<	(car pt)
		(+
		  (/
		    (* (- (car p2) (car p1))
		       (- (cadr pt) (cadr p1))
		    )
		    (- (cadr p2) (cadr p1))
		  )
		  (car p1)
		)
	     )
	   )
	    (setq r (not r))
	 )
       )
      (cons (last pts) pts)
      pts
    )
    r
  )
  (defun bbox (pts)
    ((lambda (p1 p2)
       (list p1
	     (list (car p2) (cadr p1))
	     p2
	     (list (car p1) (cadr p2))
       )
     )
      (apply 'mapcar (cons 'min pts))
      (apply 'mapcar (cons 'max pts))
    )
  )

  (if
    (and
      (setq pl (car (entsel "\nSélectionnez une polyligne: ")))
      (setq elst (entget pl))
      (= (cdr (assoc 0 elst)) "LWPOLYLINE")
    )
     (progn
       (setq points (massoc 10 elst)
	     bbx    (bbox points)
       )
       (command-s "_.zoom" "_window" (car bbx) (caddr bbx))
       (if (setq ss (ssget "_W"
			   (car bbx)
			   (caddr bbx)
			   '((0 . "LWPOLYLINE") (-4 . "&") (70 . 1))
		    )
	   )
	 (repeat (setq i (sslength ss))
	   (setq pl  (ssname ss (setq i (1- i)))
		 pts (massoc 10 (entget pl))
	   )
	   (if
	     (or
	       (vl-every '(lambda (p) (isPtInside p points))
			 (bbox pts)
	       )
	       (vl-every '(lambda (p) (isPtInside p points))
			 pts
	       )
	     )
	      (setpropertyvalue pl "Color" "5")
	   )
	 )
       )
       (command-s "_.zoom" "_previous")
     )
  )
  (princ)
)

 

 

Depassement des limites.dwg