Contour hachures retrouvé ! (Ecrit en VBA)

laurent_a8 · le 2 août 2011

Bonjour le forum,

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

J’ai trouvé sur le forum le code en lisps pour recrée une polilygne autour d’une achur, J’aurais souhaité savoir si une personne a la connaissance de se même code (écrit en VBA)

Le but est de crée une polyligne associative a une achur (alors que celle-ci n’est aucune polyligne associative à la base)

Merci par avance

Laurent

didier · le 3 août 2011

coucou

à moins que tu utilises une version ancienne

la possibilité de recréer un contour de hachures existe en natif

commande : EDITHACH (ou _ HATCHEDIT)

Un bouton te permets de recréer les contours,

ensuite à la ligne de commande il te sera demandé

si tu veux une Polyligne ou une Région

et enfin su tu veux réactiver l'associativité avec ce nouveau contour.

la preuve en image (version 2011) :

http://images.imagehotel.net/u4tu6zi3ps.jpg

Amicalement

oops je me suis trompé d'image (hihihi)

laurent_a8 · le 3 août 2011

Bonjour Didier et aussi le forum,

Sous autocad 2012 j'ai fait se bout de code qui récupére les informations des hachures sans qu'elle soit liées a une polyligne, j'aurais souhaité faire le contour de cette hachure pour en avoir despolyligne, il y a un lisp qui fait cela et que j'ai récuperé, le eul soucie c'est qu'il recrée toute les lignes sur le calques 0 (j'aurais voulut avec la propriété du claque de cette hachure pour la polyligne généré)

Je suis novice sur se forum et si je ne suis pas au bonne endroit mille excuses.

je joint le bout de code valable pour Autocad 2012 a modifier avec les version antéireur.

Code

= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = == = =

Public Sub InformationHachure()

'définition des variables nécessaires à la hachure du symbole

Dim objHatch As AcadHatch ' Variable de l'objet Hachure

' Variable du calque

Dim objObjet As AcadEntity ' Variable de l'objet sur le Calque

Dim objCalque As AcadLayer ' Variable de l'objet du Calque

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

' ----> Programme Autocad capture des objets du dessin via une fenêtre de capture

' Suppression du jeu de selection ("PremièreSélection")

ThisDrawing.SelectionSets("PremièreSélection").Delete

' Définition d'un jeu de sélection

Set ssetObj = ThisDrawing.SelectionSets.Add("PremièreSélection")

' Capture fenêtre active de sélection "Nota : tous les objets sont mémorisé dans la création d'une séléction = "PremièreSélection"

ssetObj.SelectOnScreen

' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

' Programme Autocad "Traitement des données récupéré"

' Objectif = Faire un contour de l'hachurage avec la reprise de la propriété du calque de dépendence de la hachure

' Avec Autocad 2010 et plus il y a l'option recrée un contour de la hachure via une polyligne (Pour l'instant je sais

' pas comment la réalisé)

' Pour le moment je sort les information de mon hachurage via une msgbox

' Air

' Nom Du Calque

For Each entite In ssetObj ' Boucle de selection des objects capturé a l'écrans ( = tous "ssetObj") et "Entite" = Premier selectioné etc...

Select Case entite.EntityName ' boucle Select === >>> Non de l'object selectionné (Ligne, Polyligne, Hachurage, etc...)

Case "AcDbHatch" ' Selection de l'object a annalysé dans cette ensemble de selection (Ici Hachurage)

MsgBox entite.Layer ' Nom du claque

MsgBox entite.Area ' Aire de la hachure

End Select ' Fin de la boucle de selection (Select Case)

Next entite ' Instruction suivante de la boucle For Each qui scanne tous les objects capturé

End Sub ' Fin de la boucle

= = = = = = = = = = = = = = = = = = = = == = = = = = = = = = = = = = = = = = = == = = == = = ==

1 ) ouvrir un fichier autocad

Crées des hachures sur différent calques (Vous pouvez retirer les polyligne associative)

une fois qu'il n'y a que des hachures sur le fichier autocad.

2 ) Crée un projet dvb (Copier le code et enregister)

Outils > Macros VBA > Macros... Choisir ( InformationHachure ) > Executer

il y aura des Message pour le nom du claques et aussi l'air de l'hachurage (Pour tous ceux selectioné)

Merci si vous avez des complément d'information pour cette idées que j'ai je peux aussi vous aider avec excel (VBA)

au plaisir de vous lire

Ps : Merci didier, cela fait trés longtemps que je suis inscrit sur le forum mais j'ai réelement apris le vba avec excel et je commence avec Autocad, je suis pas fort dans le sens que je ne suis pas prétentieux, mais j'ai lu enormément. il y a un livre qu s'achete en pdf sur le coin des autocadien et je pense l'acheter prochainement je sais pas si cela est vraiment sérieux?

Peux être que vous avez des notion plus avancer que moi avec autocad, et je serais enchanter de pouvoir contribuer vous aider ou d'autre sur se forum.

Merci vraiment au plaisir de vous lire et vous répondre

Laurent

didier · le 4 août 2011

coucou

je connais ce livre, il est pas mal, sans plus...

mais j'aurais aimé que tu me répondes :

pourquoi programmer quelque chose qui existe en natif ?

pour le fun, je suis d'accord.

amicalement

(gile) · le 4 août 2011

Salut,

Je pense comme Didier : pourquoi programmer ce qui existe déjà ?

En utilisant la commande native _ HATCHEDIT, proposée par Didier, on peut automatiser l'exécution sur un jeu de sélection et l'attribution du calque (commande : HBOUND).

(defun c:hbound	(/ ss echo n ent elast lay)
 (princ "\nSélectionnez les hachures (Entrée, Espace ou clic droit pour toutes")
 (if (or (setq ss (ssget '((0 . "HATCH"))))
  (setq ss (ssget "_X" '((0 . "HATCH"))))
     )
   (progn
     (setq echo (getvar 'cmdecho)
    n	 -1
     )
     (setvar 'cmdecho 0)
     (while (setq ent (ssname ss (setq n (1+ n))))
(setq elast (entlast)
      lay   (assoc 8 (entget ent))
)
(if (= 0 (cdr (assoc 97 (entget ent))))
  (vl-catch-all-apply
    '(lambda ()
       (command "_.hatchedit" ent "_boundary" "_polyline" "_yes")
     )
  )
)
(while (setq elast (entnext elast))
  ((lambda (l)
     (entmod (subst lay (assoc 8 l) l))
   )
    (entget elast)
  )
)
     )
     (setvar 'cmdecho echo)
   )
 )
 (princ)
)

En utilisant les données DXF de la hachure ce qui relève plus du défi pour le fun (adapté du code donné ici pour l'attribution du calque).

;;; TRUNC-IF Retourne la liste tronquée à partir de la première occurrence qui
;;; retourne T à la fonction (complémentaire de celle retournée par VL-MEMBER-IF)

(defun trunc-if	(fun lst)
 (if (and lst
   (not ((eval fun) (car lst)))
     )
   (cons (car lst) (trunc-if fun (cdr lst)))
 )
)

;;; Ang<2pi
;;; Retourne l'angle, à 2*k*pi près, compris entre 0 et 2*pi

(defun ang<2pi (ang)
 (if (and (<= 0 ang) (< ang (* 2 pi)))
   ang
   (ang<2pi (rem (+ ang (* 2 pi)) (* 2 pi)))
 )
)

;; HatchBoundary
;; Reconstitue le contour de la hachure
;;
;; Argument
;; ent : le nom d'entité (ename) de la hachure

(defun HatchBoundary (ent / getloops elst elv nor lay loops slst vtx cl	alst ang1 ang2)
 (setq	elst (entget ent)
elv  (cadddr (assoc 10 elst))
nor  (assoc 210 elst)
lay  (assoc 8 elst)
 )
 (while (setq elst (vl-member-if '(lambda (x) (= (car x) 72)) elst))
   (setq slst (trunc-if '(lambda (x) (= (car x) 72)) (cdr elst)))
   (cond
     ((<= (cdar elst) 1)		; polyligne
      (setq vtx (cdr (assoc 93 slst))
     cl	 (cdr (assoc 73 slst))
      )
      (entmake
 (append
   (list
     '(0 . "LWPOLYLINE")
     '(100 . "AcDbEntity")
     '(100 . "AcDbPolyline")
     lay
     (cons 90
	   (cond (vtx)
		 (2)
	   )
     )
     (cons 70
	   (cond (cl)
		 (0)
	   )
     )
     (cons 38 elv)
     nor
   )
   (if cl
     (trunc-if
       '(lambda (x) (= (car x) 97))
       (vl-member-if '(lambda (x) (= (car x) 10)) slst)
     )
     (list (assoc 10 slst) (cons 10 (cdr (assoc 11 slst))))
   )
 )
      )
     )
     ((= (cdar elst) 2)		; arc
      (if (= (cdr (assoc 73 slst)) 1)
 (setq ang1 (cdr (assoc 50 slst))
       ang2 (cdr (assoc 51 slst))
 )
 (setq alst (list (- (* pi 2) (cdr (assoc 50 slst)))
		  (- (* pi 2) (cdr (assoc 51 slst)))
	    )
       ang1 (apply 'min alst)
       ang2 (apply 'max alst)
 )
      )
      (entmake
 (list
   '(0 . "ARC")
   lay
   (assoc 10 elst)
   (assoc 40 elst)
   (cons 50 ang1)
   (cons 51 ang2)
   nor
 )
      )
     )
     ((= (cdar elst) 3)		; ellipse
      (if (= (cdr (assoc 73 slst)) 1)
 (setq ang1 (cdr (assoc 50 slst))
       ang2 (cdr (assoc 51 slst))
 )
 (setq alst (list (- (* pi 2) (cdr (assoc 50 slst)))
		  (- (* pi 2) (cdr (assoc 51 slst)))
	    )
       ang1 (apply 'min alst)
       ang2 (apply 'max alst)
 )
      )
      (foreach	a '(ang1 ang2)
 (or
   (equal (eval a) 0 1e-9)
   (equal (eval a) pi 1e-9)
   (equal (eval a) (* 2 pi) 1e-9)
   (and	(set a (ang<2pi (eval a)))
	(if (< (* pi 0.5) (eval a) (* pi 1.5))
	  (set
	    a
	    (+
	      pi
	      (atan
		(/ (sin (eval a))
		   (* (cos (eval a)) (cdr (assoc 40 slst)))
		)
	      )
	    )
	  )
	  (set
	    a
	    (atan
	      (/ (sin (eval a))
		 (* (cos (eval a)) (cdr (assoc 40 slst)))
	      )
	    )
	  )
	)
   )
 )
      )
      (entmake
 (list
   '(0 . "ELLIPSE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbEllipse")
   lay
   (assoc 10 slst)
   (assoc 11 slst)
   (assoc 40 slst)
   (cons 41 ang1)
   (cons 42 ang2)
   nor
 )
      )
     )
     ((= (cdar elst) 4)		; spline
      (entmake
 (append
   (list
     '(0 . "SPLINE")
     '(100 . "AcDbEntity")
     '(100 . "AcDbSpline")
     lay
     (cons 71 (cdr (assoc 94 slst)))
     (cons 70 (+ 8 (cdr (assoc 73 slst)) (cdr (assoc 74 slst))))
     (cons 72 (cdr (assoc 95 slst)))
     (cons 73 (cdr (assoc 96 slst)))
   )
   (trunc-if
     '(lambda (x) (= (car x) 97))
     (vl-member-if '(lambda (x) (= (car x) 40)) slst)
   )
 )
      )
     )
   )
   (setq elst (cdr elst))
 )
)

;; Fonction d'appel (commande)

(defun c:h2b (/ ss n)
 (if (setq ss (ssget '((0 . "HATCH"))))
   (repeat (setq n (sslength ss))
     (HatchBoundary (ssname ss (setq n (1- n))))
   )
 )
 (princ)
)

(princ "\nEntrez H2B pour lancer la commande.")
(princ)

PS : Si tu commences en programmation d'AutoCAD, je te déconseillerais de choisir VBA même si tu as acquis un certain bagage dans ce langage. VBA sera prochainement abandonné par AutoCAD et est d'ores et déjà mal supporté sur les systèmes 64 bits.

AutoLISP/Visual LISP est issu du LISP ce qui en fait un langage un peu "à part" (programmation fonctionnelle et syntaxe particulière) mais est en fait assez facile d'accès et très étroitement intégré dans autoCAD.

La plateforme .NET supporte plusieurs langages dont VB.net qui pourrait sembler plus facile pour quelqu'un venant du VB(A) parce que la syntaxe est proche, mais la ressemblance s'arrête là. DotNet est plus puissant mais (beaucoup) moins abordable et pas du tout intégré à AutoCAD.

laurent_a8 · le 4 août 2011

Bonsoir Didier et Gile, ainsi que le forum.

Excuser moi Didier je suis désolé d’être passé à côté de votre question, j’utilise en faite une ancienne version d’Autocad = version 2005.

En faite ce n’est pas vraiment pour le fun car je dois me servir de cette fonctionnalité qui ne marche pas non plus sous Autocad 2012.

Explication du travail que je dois réaliser :

1 ) je récupère les plans des architectes sous différente version d’Autocad (2005 ou 2010) moi j’ai la version 2005. sur ces plans je dois uniquement récupérer les Hachures et leur polylignes associatives.

2 ) ce qui m’interresse c’est uniquement les hachures sans les polylignes associatives (car doublon et des fois plus de plolygne que de hachures) = ingérable !!

3 ) je fait un filtre de sélection avec la commande autocad et je sélectionne toute les hachures du dessins, puis je les copie (Ctrl + V)

4 ) J’ouvre un autre plans et je colle avec les coordonnée d’origine toute les hachures (Copier) sur se nouveau dessin autocad vierge.

5 ) après un petit nettoyage pour m’assurer de travailler que sur les calque qui m’intéresse (1 calque pour un type de hachure)

6 ) je dois reconstituer toute les polyligne autour des hachures restantes (comme chaque polyligne reprend la propriété du calque d’origine de la hachure) j’ai exactement le même nombre de polylignes que de hachures et pour chaques claques j’ai exactement le même nombre de hachures que de plolyligne.

7 ) Par la suite je peux travailler sur un calques en le rendent actif et en désactivant les autres, ce qui me pemet d’appeler en Xref le plans par exemple de départ et de vérifier la cohérence de la zone définit (si cela correspond pas je peux modifier la polyligne par exemple : la découper en 2 (car deux zone diffrérentes) et recréer des hachurages différent.

Je ne sais pas si j’ai était très claire mais le final c’est de faire des surfaces de différentes zones et de les identifier rapidement pour en faire des quantités.

Juste un très grand Merci a Gile dont votre lips est Unique est formidable (H2B) ce qui fait exactement se que j’ai décris dans mes besoins. Formidable.

Pour Didier : la possibilité de recréer un contour de hachures existe en natif

En faite je peux traiter les hachures une par une avec autocad 2010 (j’ai testé aujourd’hui chez un collégue)

Pour Gile : avec une achure en forme de carré = 4 côtés (les deux types de hachures cité = les deux même carrés avec couleur différentes se sont des solides pour le remplissage).

J’ai récupéré aujourd’hui des hachures des architectes et le lips se comporte de deux manières différentes

Pour un type de hachures (Carré 1) = il fait bien les contours avec une polyligne fermer (1 polyligne fermer qui forme le périmètre du carré)

Pour l’autre type de hachures (Carré 2) = il fait bien le coutour aussi avec des ploilyligne mais elles ne sont pas fermer. (4 polylignes ouvertes qui forme les périmètres du carré)

PS : j’ai fais un fichier .dwg ou il y a les deux type de hachures (pour que vous puissiez tester cela je ne peux pas trouver la raison car je n’y connais rien en lips, c’est pour cela que j’ai essayé de faire en vba mais je n’y arrive pas pour l’instant.

Comment je peux faire pour vous laisser mon fichier .dwg pour que vous testiez se comportement différent (sur deux type de hachures toute a fait semblables ?)

Je peux vous laisser mon courriel sur se poste ? Comment faire ?

Merci Didier pour votre réponse au sujet du livre VBA pour autocad je pense l’acheter prochainement.

Laurent

laurent_a8 · le 5 août 2011

Bonjour,

Aprés vérification, cela semble du au différence de version ,lorsque les hachures sont réaliser sous Autocad 2010 et que le fichier est enregistrer sour Autocad 2005 cela produit des lignes aux (Format polyligne) mais autant de polyligne qu'il y a de face exemple si c'est un triangle (3 faces donc 3 polylignes).

Il faudrait tester si le comportement et le même si (ont utilise se lisps directement avec Autocad 2010) si cela produit la même choses c'est a dire ( pour le triangle les 3 lignes (format polyligne non jointe entre elle)

Pour ma part je ne sais pas faire la progression avec le lips pour exectute le programe pas a pas (en VBA c'est avec la touche F8 au clavier)

Pour le test j'ai réaliser des Hachures de différentes facon pour comprendre comment j'ai des lignes (format polyligne non jointe) au nombre de faces de ma hachures (exmple le triangle) et parfois une plolyligne fermer).

J'ai donc fait le triangle :

1 ) une suite de polyligne (3 que j'ai joint sans clor) = pour une hachure

2 ) une suite de polyligne (3 que j'ai joint que j'ai clos) = pour une autre hachure

3) tester avec le rectangle (porposer par autocad)

J'ai réaliser cela avec autocad 2010 (sans tester directement le lisps (H2B) sur cette version car c'est pas ma machine.

Par contre j'ai enregister le fichier sous Autocad 2004 ( C'es ce que me propose Autocad 2010) pour la version qui se rapproche le plus de la mienne (Autocad 2005)

Et c'est a se mment la que j'ai constater cette anomalie (qui je pense est du au différente version) je connais cela en VBA aussi avec Excel Notament.

Peut être vous avez une solution a cela, mais dans tous les cas je vous remerci vraiment car votre programe est formidable (j'avais pu voir un programe semblabe sur un site je vous en fait part mais le votre est 100 fois mieux : http://www.jtbworld.com/lisp/hatchb.htm) j'avais récuper la version 2.2 c'était il y a mainenant 5 ans je pense.

Merci Laurent

Connexion

Contour hachures retrouvé ! (Ecrit en VBA)

Messages recommandés

laurent_a8

didier

laurent_a8

didier

(gile)

laurent_a8

laurent_a8

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante