bryce

Bonjour, (command "_-linetype" "_l" "*" "acadiso.lin") (while (> (getvar "cmdactive") 0) (command "") ) Mais ne vaudrait-il pas mieux recharger uniquement les types de ligne utilisés dans le dessin, plutôt que de recharger tout le fichier acadiso.lin ? Si tu purges après, ce n'est pas grave, mais bon...

J'allais le dire, ça transformait l'integer en variant... Tu as une ligne inutile en haut du coup. ;) Dim FiltersType, FiltersData As Variant

Je ne sais pas si les array sont dynamiques ou pas en VBA... Si la réponse est non, il faut peut être redimensionner les 2 array FilterType() et FilterData() ? Peut-être qu'il suffit de déclarer le 2e élément (indice 1) des tableaux, comme tu l'as fait au début du code pour les 1ers (indice 0) ? Dim FilterType(1) As Integer Dim FilterData(1) As Variant

Bonjour, Je ne m'y connais pas vraiment en VBA, mais je dirais qu'il faudrait remplacer : FilterType(0) = 8 FilterData(0) = NewZone par quelque chose comme ça : FilterType(0) = 0 ' code DXF du type de l'objet FilterData(0) = "LWPOLYLINE" ' type de l'objet FilterType(1) = 8 ' code DXF du calque de l'objet FilterData(1) = "0" ' nom du calque pour ne garder que les polylignes appartenant au calque 0.

Bonjour, Voici une version modifiée pour fonctionner aussi dans la 2013 : ;;; OB2WO -Gilles Chanteau- 10/03/07 ;;; Crée des "Wipeout" à partir des objets sélectionnés (cercle, ellipse, ou polyligne avec arcs) ;;; Fonctionne en 3D ;;; Modifié le 03/11/07 ;;; - plusieurs objets peuvent être sélectionnés ;;; - le wipeout est créé sur le calque de l'objet ;;; Modifié le 26/08/09 ;;; - ajout vl-catch-all-apply ;;; Modifié le 27/06/2012 par Brice Studer ;; - compatibilité AutoCAD 2013 de la routine MakeWipeout (defun c:ob2wo (/ ss) (vl-load-com) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (if (ssget '((0 . "CIRCLE,ELLIPSE,LWPOLYLINE"))) (progn (initget "Oui Non") (setq del (getkword "\nEffacer les objets source ? [Oui/Non] <Non>: ")) (vla-StartundoMark acdoc) (vlax-for obj (setq ss (vla-get-activeSelectionSet acdoc)) (vl-catch-all-apply '(lambda (/ lst nor lay) (setq lst (ent2ptlst obj) nor (vlax-get obj 'Normal) lay (vla-get-Layer obj) ) (makeWipeout lst nor lay) (and (= del "Oui") (vla-delete obj)) ) ) ) (vla-delete ss) (vla-EndundoMark acdoc) ) ) ) ;;; ENT2PTLST (gile) ;;; Retourne la liste des sommets successifs du polygone approchant un objet courbe ;;; Coordonnées exprimées dans le SCO (defun ent2ptlst (ent / obj dist n lst p_lst prec) (vl-load-com) (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) (setq obj ent ent (vlax-vla-object->ename ent) ) ) (cond ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE")) (setq dist (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) 50 ) n 0 ) (repeat 50 (setq lst (cons (trans (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n)))) 0 (vlax-get obj 'Normal) ) lst ) ) ) ) (T (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (cons (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) lst ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst)))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (cons (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 ent ) lst ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) lst ) ;;; MakeWipeout (gile) ;;; Crée un objet "wipeout" à partir d'une liste de points et du vecteur normal de l'objet (defun MakeWipeout (pt_lst nor lay / dxf10 max_dist cen dxf_14) ;(or (member "acwipeout.arx" (arx)) (arxload "acwipeout.arx")) (or (wcmatch (ver) "*2013*") (member "acwipeout.arx" (arx)) (arxload "acwipeout.arx")) ; modif compatibilité AutoCAD 2013 (setq dxf10 (list (apply 'min (mapcar 'car pt_lst)) (apply 'min (mapcar 'cadr pt_lst)) (caddar pt_lst) ) ) (setq max_dist (float (apply 'max (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10) ) ) ) (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0))) (setq dxf14 (mapcar '(lambda (p) (mapcar '/ (mapcar '- p cen) (list max_dist (- max_dist) 1.0) ) ) pt_lst ) ) (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14)))) (entmake (append (list '(0 . "WIPEOUT") '(100 . "AcDbEntity") (cons 8 lay) '(100 . "AcDbWipeout") '(90 . 0) (cons 10 (trans dxf10 nor 0)) (cons 11 (trans (list max_dist 0.0 0.0) nor 0)) (cons 12 (trans (list 0.0 max_dist 0.0) nor 0)) '(13 1.0 1.0 0.0) '(70 . 7) '(280 . 1) '(71 . 2) (cons 91 (length dxf14)) ) (mapcar '(lambda (p) (cons 14 p)) dxf14) ) ) ) (princ "\nCommande à utiliser : OB2WO") (princ)

Bonjour, Je pense que tu gagnerais en performances et en temps en utilisant l'extraction de données pour créer ton tableau, plutôt que de créer 36000 champs à la main.

Bonjour, Dans les options, onglet Affichage, en bas à gauche il y a une case à cocher "Afficher l'arrière-plan papier".

Bonjour, Je dirais : \p -> saut de paragraphe \l -> saut de ligne.

Bonjour, (vl-string-search "110" "CV-110 EG") retourne 3, qui est la position du 1er caractère de la chaîne recherchée (càd le 4e caractère, car numéroté à partir de 0). (vl-string-search "111" "CV-110 EG") renvoie nil.

Bonjour, Tu peux filtrer un peu mieux la sélection des lignes, par exemple : (ssget '( (0 . "LINE") (-4 . "<OR") (-4 . "<AND")(62 . 9) (6 . "CACHE")(-4 . "AND>") (-4 . "<AND")(62 . 256)(6 . "BYLAYER")(-4 . "AND>") (-4 . "OR>") ) ) sélectionnera uniquement des lignes qui sont soit en couleur 9 et tdl CACHE, soit en couleur et tdl DuCalque. ( = "9" ptcouleur) renvoie toujours nil car la couleur est un numéro, et non une chaîne de caractères. Il faut faire ( = 9 ptcouleur) Dans ta boucle while, tu fais une 10aine de fois un entget sur le même objet. Je pense que tu devrais créer une variable pour stocker cette liste (setq ptlist (entget ptname)) et remplacer tous les (entget ptname) par cette variable ptlist.

Bonjour, Dans l'éditeur de bloc, regarde les propriétés du paramètre de distance correspondant à cette action d'étirement. L'incrément est probablement défini à 1000.

Bonjour, Je crois que Christian a oublié de préciser que sa macro utilise 2 variables (useri3 et userr2) pour convertir les mesures en m et m² si besoin. Ces variables sont à 0 par défaut, la macro ne fonctionnera donc pas (erreur de division par 0). Essaie en mettant les variables USERI3 et USERR2 à 1 (si ton dessin est déjà en mètres, ça devrait être ok). ;)

Bonjour, Ça peut se faire avec un bloc dynamique et un champ, exemple en vidéo: Le bloc: https://www.box.com/s/933087b88bcfbf61a6c1

Bonjour, Tu ne pourras pas utiliser une formule comme abs dans la palette Propriétés... Je te propose un Lisp qui filtre les blocs ayant une coordonnée X et/ou Y négative, et modifie ces coordonnées d'insertion en positif (c'est que j'ai compris de ta demande): (defun c:ABSBL ( / acdoc filter ss i b code10 ) (vl-load-com) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) filter '( (0 . "INSERT")(-4 . "<OR")(-4 . "<,*,*")(10 . (0 0 0))(-4 . "*,<,*")(10 . (0 0 0))(-4 . "OR>") )) (if (cadr (ssgetfirst)) (setq ss (ssget "_I" filter)) (progn (prompt "\nSélectionnez les blocs à modifier ou <entrée pour tous> : ") (or (setq ss (ssget filter)) (setq ss (ssget "_X" filter)) ) ) ) (if ss (progn (vla-startundomark acdoc) (setq i 0) (repeat (sslength ss) (setq b (entget (ssname ss i)) code10 (cdr (assoc 10 B)) ) (setq code10 (mapcar 'abs code10)) (entmod (subst (cons 10 code10) (assoc 10 B) B)) (setq i (1+ i)) );repeat (setq ss nil) (vla-endundomark acdoc) );progn ) (princ) )

Bonjour, Ce que tu voudrais faire n'est pas malheureusement pas possible avec les blocs dynamiques à ce jour, d'où le manque de réponses...

Bonjour, Ce serait bien plus simple je pense d'exporter ton bloc avec WBLOC, et de ranger le fichier dwg dans un chemin de recherche d'AutoCAD. En effet, quand AutoCAD ne trouve pas un bloc (TOTO par ex.), avant de râler il essaie d'insérer un fichier dwg du même nom (TOTO.dwg) s'il en trouve un dans ses chemins. ;)

Bonjour, Tu peux aussi utiliser un bloc dynamique (contenant un champ qui affiche la coordonnée Y de son point d'insertion) en remplacement des cotes ordonnées.

Bonjour, Probablement un bug... En attendant le Service Pack 1, avez-vous essayé de faire un balayage plutôt qu'une extrusion ?

Bonjour, Un peu tard, mais voici un autre Lisp : (defun DIGITOPO ( insertion3D / bloc etiquette doc mspace pt attval blocOj ) (setq bloc "BlocPoint" ; nom du bloc à insérer (doit exister dans le dessin, ou dans un des chemins de recherche d'AutoCAD) etiquette "ALT" ; étiquette de l'attribut Altitude ) (vl-load-com) (if (not (or (tblsearch "BLOCK" bloc) (setq bloc (findfile (strcat bloc ".dwg"))) ) ) (progn (princ "\nBloc non trouvé !\n") (exit) ) ) (setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) mspace (vla-get-ModelSpace doc)) (while (setq pt (getpoint "\nChoix du point : ")) (setq attval (getreal "\nAltitude : ")) (if (and insertion3D attval) (setq pt (reverse (cons attval (cdr (reverse pt)))) ) ) (setq blocObj (vla-InsertBlock mspace (vlax-3d-point pt) bloc 1 1 1 0)) (if attval (mapcar '(lambda ( att ) (if (= etiquette (vla-get-Tagstring att)) (vla-put-Textstring att (rtos attval)) ) ) (vlax-invoke blocObj 'getAttributes) ) ) ) (princ) ) (defun c:DIGITOPO2D (/) (digitopo nil) ) (defun c:DIGITOPO3D (/) (digitopo T) ) (princ "\nCommandes : DIGITOPO2D ou DIGITOPO3D") (princ)

Bonjour, Tes types de ligne utilisent un style de texte appelé WINGDINGS. Ce style de texte doit donc exister dans le dessin pour pouvoir charger ces types de ligne. Essaie de créer un nouveau style de texte appelé WINGDINGS, et utilisant la police du même nom avec une hauteur de 0. Edit: oups, grillé... :P

Bonjour, Les variables concernant l'ordre de tracé sont DRAWORDERCTL et SORTENTS, quelles sont leurs valeurs ?

Je me trompe peut-être, mais personnellement j'ai plutôt l'impression que, comme pas mal de monde, pointpower ne sait pas utiliser correctement la commande Etirer. Je rappelle donc que pour utiliser la commande Etirer, quand il demande de choisir les objets il ne faut pas cliquer sur l'objet. Il faut faire une fenêtre de capture (de droite à gauche, la verte) ou un polygone de capture (entrer cp dans la ligne de commande), en n'englobant que les sommets à étirer.

Si ! Avec la commande Etirer !

Bonjour, Si tu ne vois pas les flèches rouge et jaune en bas à gauche, tu devrais enlever tes lunettes de soleil ! :P Désolé, j'ai pas pu résister...

Bonjour, Si tu as AutoCAD 2012, tu pourras trouver sur Autodesk Exchange un plugin gratuit pour exporter plusieurs blocs en une fois : AutoWblock, par DotSoft LLC. http://apps.exchange.autodesk.com/ACD/Detail/Index?id=appstore.exchange.autodesk.com%3aAutoWblock%3aen Une fois les blocs exportés dans un répertoire, je te propose d'utiliser dans chaque dessin à mettre à jour le petit Lisp ci-dessous : (defun c:MREDEF ( / dir files f b ) (if (setq dir (acet-ui-pickdir) files (vl-directory-files dir "*.dwg" 1) ) (progn (foreach f files (if (tblsearch "block" (setq b (vl-filename-base f))) (progn (command "_-insert" (strcat b "=" dir "\\" f)) (command) ) ) ) ) ) ) Écrit et testé selon la rigoureuse méthode appelée communément "à l'arrache", il te permettra de redéfinir tous les blocs présents sous forme de fichiers dwg dans le dossier choisi. Les outils Express doivent a priori être installés pour que ça fonctionne.