Trier Lignes...

[Bred]

Salut,

J'ai un problème... qui va faire plaisir à certain...

J'explose une region qui a un ou plusieurs "perçage"

J'obtiens une liste de ligne...

(#< VLA-OBJECT IAcadLine 01f1da0c > #< VLA-OBJECT IAcadLine 2d50fe04 > #< VLA-OBJECT IAcadLine 2d50fda4 >....

 

Afin de réaliser le hachurage ( je n'hachure pas les "perçages"), il faut que je détermine quels sont les lignes "exterieures" afin de leur appliquer AppendOuterLoop, et ensuite les formes interieures afin de leur appliquer AppendInnerLoop...

et je ne sais pas comment faire...

 

merci d'avance !!!!!

 

[Edité le 13/12/2007 par Bred]

[(gile)]

Salut,

 

Tu peux t'inspirer ou utiliser R2Pl qui transforme une ou plusieurs régions en polylignes fermées.

[Bred]

Merci (gile) !

je me jette dessus avec plaisir !

[Bred]

Re,

J'ai "bricolé" ton code, et j'ai fais une routine :

Argument : la liste de ligne en vla

Retour : Les listes des lignes par formes, la première étant le contour exterieur.

 

But de cette routine :

Base : un region quelquonque exploser et dont on a récupérer la liste d'éléments.

But : Sortir forme "exterieure" de la region et formes inetrieures afin d'y appliquer des hachures.

;;; Routine pour Trier Region exploser et ressortir
;;; Forme exterieure et FormeS interieures (d'apès code R2PL (gile) CadXP)
(defun Tri-li->lstforhatch-Out-In (lstli / AREA AREA-P BLG BLST DLST LSTF OLST PLINE PLST TLST X lst-C LST-C LSTLI N)  
 (defun arcbulge (arc)
   (/ (sin (/ (vla-get-TotalAngle arc) 4))
      (cos (/ (vla-get-TotalAngle arc) 4)))
   )
 (if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine") 
			 (= (vla-get-ObjectName x) "AcDbArc")
			 (= (vla-get-ObjectName x) "AcDbCircle"))) lstli)    
   
   (progn
     ; sort les cercles
     (mapcar '(lambda (x) (if (= (vla-get-ObjectName x) "AcDbCircle")
		   (setq lst-C (append (list x) lst-C)
			 lstli (vl-remove x lstli)))) lstli)
     ; création liste ( (# (-7.37653 3.80662 0.0) (-7.37653 6.064 0.0)) (.....
     (setq olst (mapcar '(lambda (x)
		    (list x (vlax-get x 'StartPoint)(vlax-get x 'EndPoint))) lstli))

     (while olst
(setq blst nil)
(if (= (vla-get-ObjectName (caar olst)) "AcDbArc")
  (setq blst (list (cons 0 (arcbulge (caar olst))))))
(setq plst (cdar olst) ; 2x coord 1ère ligne
	    dlst (list (caar olst)) ; 1ère ligne
	    olst (cdr olst) ; enlève 1ère ligne de la liste
	    )

;;; RECUP CONTOUR
(while ; tant quej'ai tlst= denière coordonnées 1ère ligne = coordonnées dans olst
  (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9)
					    (equal (last plst) (caddr x) 1e-9))) olst))
  ; si denière coordonnées 1ère ligne = denière coordonnées 1ère ligne dans nouvelle liste
  (if (equal (last plst) (caddar tlst) 1e-9)
    (setq blg -1)
    (setq blg 1)
    )
  (if (= (vla-get-ObjectName (caar tlst)) "AcDbArc")
    (setq blst (cons (cons (1- (length plst))
			   (* blg (arcbulge (caar tlst)))) blst)))

  ; raoute point suivant à plst
  (setq plst (append plst (if (minusp blg) ; si blg = -1
			    (list (cadar tlst)) ; 1ère coord 1ère ligne dans nouvelle liste
			    (list (caddar tlst)))) ; 2nde coord 1ère ligne dans nouvelle liste
	dlst (cons (caar tlst) dlst) ; ligne suivante accepté dans dlst
	olst (vl-remove (car tlst) olst) ; enlève liste 1ère ligne dans olst
	)
  );FIN récup CONTOUR

; Dessine Polyligne pour récupérer Surface
; (Surface+Grande = Forme Exterieure)
(setq pline (vlax-invoke (getspace) 'addLightWeightPolyline
			 (apply 'append (mapcar '(lambda (x)
						   (setq x (trans x 0 Norm))
						   (list (car x) (cadr x)))
						(reverse (cdr (reverse plst)))))))
(vla-put-Closed pline :vlax-true)
(mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst)
(vla-put-Elevation pline (caddr (trans (car plst) 0 Norm)))
(vla-put-Normal pline (vlax-3d-point Norm))

(setq area (vla-get-Area pline))

(if area-p
  (if (< area-p area)
    (setq lstF (append (list dlst) lstF))
    (setq lstF (append lstF (list dlst)))
    )
  (setq lstF (append (list dlst) lstF))
  )
(setq area-p area)	    
(vla-delete pline)	
)
     ;traitement cercles
     (if lst-C
(repeat (setq n (length lst-C))
  (setq area (vla-get-Area (nth (setq n (1- n)) lst-C)))
  (if (< area-p area)
    (setq lstF (append (list (list (nth n lst-C))) lstF))
    (setq lstF (append lstF (list (list (nth n lst-C))))))
  (setq area-p area))
)
     )    
   ) 
 lstF
)

 

[Edité le 14/12/2007 par Bred]

[(gile)]

Salut,

 

Je n'ai pas décortiqué ton code, mais n'est il pas plus simple de conserver les polylignes pour comparer les aires et les passer ensuite directement comme arguments à vla-AppendOuterLoop et vla-AppendInnerLoop ?

 

ou mieux des listes de polylignes avec

(vlax-invoke Hatch 'AppendOuterLoop (list plus_grande_poly))

(vlax-invoke Hatch 'AppendInnerLoop liste_autres_poly)

[lecrabe]

 

Hello Gilles

 

C interessant les regions avec des ilots et obtenir des polylignes avec ta routine R2PL,

c super aussi ! :)

 

A propos, le fameux objet graphique MPOLYGON qui n'existe que dans MAP (ou CIVIL) serait il (A ton avis) aussi interessant dans un AutoCAD "simple" !, Qu'en penses tu ?

 

Comment refaire une commande MPOLYGON dans AutoCAD ... :exclam:

 

Le Decapode (MPOLYGONant)

 

[Bred]

Je n'ai pas décortiqué ton code, mais n'est il pas plus simple de conserver les polylignes pour comparer les aires et les passer ensuite directement comme arguments à vla-AppendOuterLoop et vla-AppendInnerLoop ?

Je m'y attendais à celle là...

Le truc c'est que je m'en sers comme sous-routine dans un code de plus de 300 lignes, déjà créés il y a quelque temps, et ou je ne traite pas des polyligne mais des lignes...

Faudrais pour faire plus propre que je retouche cette partie du code pour lui faire accepter les polylignes, mais là, je suis en phase de test... et je n'ai pas trop le temps....

 

Merci en tous cas, comme d'habitude, de ton aide et de tes remarques !

J'en prends note.

 

[(gile)]

Salut lecrabe,

 

N'ayant pas l'usage des MPolygons, je ne me suis pas trop penché sur la question.

Mais ça ne me semble pas impossible à créer à partir de polylignes et d'un motif de hachures, tous les codes DXF sont renseignés dans l'aide d'AutoCAD.

[lecrabe]

 

Hello

 

Je viens de tester CURV & RECT sous MAP 2004 et MAP 2008, un seul mot : EXCELLENT ! :)

 

L'évolution dynamique de CURV est TIP-TOP :D :cool:

 

Merci Gilles pour tes multiples contributions, Le Decapode

 

[lecrabe]

Hello Gilles

 

L'avantage des MPOLYGONs c'est que les hachures sont en fait (comme dans les logiciels de type SIG) une propriété LOCALE du MPOLYGON ! :)

 

Il n'est donc pas nécessaire (sauf exception exceptionnelle) de faire une hachure sur le MPOLYGON :D

 

Par contre, il y a un inconvénient majeur (A mon sens) la hachure LOCALE ne peut pas avoir une épaisseur de trait/ligne différente de celle du MPOLYGON !! :exclam:

 

Et ça m'énerve prodigieusement !!! :(

 

Alors qu'il est possible de spécifier une couleur particulière à la hachure LOCALE ! :P

 

Le Decapode

 

 

[Edité le 13/12/2007 par lecrabe]

[Bred]

Salut,

J'ai édité la routine précédente afin qu'elle tri (filtre) aussi les cercles.

Et j'ai expliqué en intro aussi le but réel de cette routine.