Bred

Salut (gile), j'ai fait un petit test de ta routine, et si je l'ai bien compris j'ai une erreur : si je me met en vue parrallèle au SCG (face, gauche...) et en vue isométrique S-O, S-E ... ça fonctionne. Par contre, si je me met en vue "quelquonque", mon bloc ne s'aligne pas sur cette vue.

Salut, je délaisse beaucoup ce forum actuellement (contre ma avolonté...) et je n'avais pas vus ton message J'ai fait les test avec les rotations que tu indiques, et chez moi ça fonctionne, pour text ou mtext... si d'autre pouvais me confirmer cette erreur, merci.

Salut, Vu que tu sais récupérer les points d'une polyligne en dxf, il suffit de calculer l'angle de ces points : (angle p1 p2)

Salut, Peut-être suis-je le seul, mais j'avoues ne pas comprendre ta question...

Salut, personnellement, pour lancer des macros VBA, j'utilise le lisp, ce qui permet de créer une commande "répétable" comme tu le décris (en validant pour relancer la commande précedement lancé) : exemple (defun c:MACOMMANDE () (command "-vbarun" "MON_DVB.DVB!MODULE_MON.NOMduMODULE") (princ) )

Salut, une piste : Tu récupères l'angle de tes deux points de lignes et tu fait faire une rotation de cet angle à l'insertion de ton bloc

Salut, une manière Avec le DVD d'installation. démarrer - panneau de config - ajout/suppress de prog - choisie autocad2008 et modider.

Salut, Si je comprends bien, ce que tu veux faire c'est passer des arguments à une fonction. (le forum "débuter en lisp" aurait été plus approprié.) Les arguments à passer dans une fonction lisp juste après (defun .... Exemple : (defun additionne-ça ([b]arg1 arg2 arg3[/b]) (+ arg1 arg2 arg3) ) donc, si tu fais : (additionne-ça 8 2 3) ça te retournera 13. et si tu fais (additionne-ça 8 2 nil) ça te retournera 10. Ne pas confondre avec la déclaration de variable locale !!! (defun additionne-ça (arg1 arg2 arg3 [b]/ result[/b]) (setq result (+ arg1 arg2)) )

Normalement le point d'insertion s'élevé sur les Z de la valeur du texte joint.... Si ce n'est pas ça, c'est un bug. Fait le moi savoir !

Salut, poste ton programme ! mais d'apès ce que je comprends cela te retourne les coordonnées d'intersection entre 2 entités, avec comme paramètre acExtendNone qui "n'étand" aucun des objet. Pour selectionner des entités selon un (des) critères précis, il faut que tu utilise les filtres de SSGET. Exemple : pour ne sélectionner que les blocs contenus dans le calque "Mon_calque" : (setq sel (ssget '((0 . "INSERT")(8 . "Mon_calque))))

Salut, C'est toujour risquer de mettre un message dans le liste de souhait : le risque étant que cela existe déjà (voir depuis 10 ans...) mais je me lance : J'aurais aimé avoir une entité qui ne soit que visible/imprimable dans un sens de vue donné... Ou pour être plus explicite : imaginé une ligne (ou polyligne) qui ne soit visible qu'en vue de dessus par exemple. Si je fait une vue de face, l'entité n'est plus visible.... [Edité le 19/6/2007 par Bred]

Salut, tu aurais dû poster ta demande dans la rubrique lisp. En autolisp - commande "purgen"- : (defun c:purgen () (repeat 4 (command "_-purge" "TO" "*" "N") ) (command "_regen") (princ) )

En fait le lisp devrait ne te donner QUE l'altitude. Souvent le Matricule est gelé, invisible ou trés petit. Le lisp fonctionne de la manière suivant : Il faut que tu es un point ET un texte représentant ton altitude. Le programme va te reconstruire en bloc tout les point + texte d'altitude équivalent, et te mettre ce point au niveau désigné.... Je ne gère pas le matricule (il faudrait autrement récupèrer 2 donnes : altitude + matricule). Essaye ça : ;;; Transforme pt+txt en point topo + modifie tous les txt en idem dans le plan.;; ;;; + met les points sur le Z correspondant ; (defun c:ass-pt-topo (/ ACDOC BLC-I COORD-BL COORD-NOD COORD-NOD/TXT COORD-PT COORD-PT/TXT COORD-TXT H-TXT LAY-NOD LAY-TXT LST-BLC LST-PT N NOD NOMBLC PT-NOD ROT-TXT SEL SEL-T SPACE TXT VAL VAL-TXT VLA-NOD VLA-TXT X) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc)) sel (ssadd) lst-pt nil) (initget 1) (setq NomBlc (getstring T "\nNom du Bloc Topo à créer: ")) (while (not (and (setq nod (car (entsel "\n Choix du point :"))) (equal (cdr (assoc 0 (entget nod))) "POINT")))) (ssadd nod sel) (while (not (and (setq txt (car (entsel "\n Choix du Texte :"))) (equal (cdr (assoc 0 (entget txt))) "TEXT")))) ; Récup valeurs (setq vla-nod (vlax-ename->vla-object nod) lay-nod (vla-get-layer vla-nod) vla-txt (vlax-ename->vla-object txt) lay-txt (vla-get-layer vla-txt) h-txt (vla-get-Height vla-txt) val-txt (vla-get-TextString vla-txt) coord-nod (vlax-get vla-nod 'Coordinates) coord-txt (vlax-get vla-txt 'InsertionPoint) coord-pt/txt (mapcar '- coord-nod coord-txt) coord-nod/txt (mapcar '+ coord-txt coord-pt/txt)) ; création attribut (vla-addAttribute Space h-txt acAttributeModePreset "Niveau" (vlax-3d-point (trans coord-txt 1 0)) "Niveau" val-txt) (chang_Calque (entlast) lay-txt) (ssadd (entlast) sel) ; création Bloc (Creatbloc NomBlc coord-nod sel) (vla-delete vla-txt) ; Récupère text idem dans dessin [b](princ "\n Text d'Altitude : ") (setq sel-T (ssget (list (cons 0 "TEXT")(cons 8 lay-txt)))) (princ "\n Nodaux à liés :") (setq pt-nod (ssget (list (cons 0 "POINT")(cons 8 lay-nod))))[/b] (repeat (setq x (sslength sel-T)) (setq txt (vlax-ename->vla-object (ssname sel-T (setq x (1- x)))) val-txt (vla-get-TextString txt) h-txt (vla-get-Height txt) rot-txt (vla-get-Rotation txt) coord-txt (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint txt))) coord-pt (mapcar '+ coord-txt coord-pt/txt) blc-i (vla-insertblock Space (vlax-3d-point (trans coord-pt 1 0)) NomBlc 1 1 1 0)) (vla-rotate blc-i (vlax-3d-point (trans coord-txt 1 0)) rot-txt) (vla-put-TextString (car (vlax-invoke blc-i 'GetAttributes)) val-txt) (vla-delete txt) (princ (strcat "\n Reste " (rtos x) " Blocs à créér.")) ) (if pt-nod (progn (repeat (setq n (sslength pt-nod)) (setq lst-pt (append (list (vlax-ename->vla-object (ssname pt-nod (setq n (1- n))))) lst-pt))) (foreach n lst-pt (vla-delete n)) ) ) ; Elève sur les Z (setq sel (ssget "_X" (list (cons 2 NomBlc)))) (repeat (setq n (sslength sel)) (setq lst-blc (append (list (vlax-ename->vla-object (ssname sel (setq n (1- n))))) lst-blc))) (foreach n lst-blc (setq val (atof (vla-get-TextString (car (vlax-invoke n 'GetAttributes)))) coord-Bl (vlax-safearray->list (vlax-variant-value (vla-get-InsertionPoint n)))) (vla-put-InsertionPoint n (vlax-3d-point (list (car coord-Bl)(cadr coord-Bl) val))) ) (princ) ) ;;; Création de Bloc Topo ; (defun Creatbloc (Nom-B p ss / BLK LST N NBT) (repeat (setq n (sslength ss)) (setq lst (cons (vlax-ename->vla-object (ssname ss (setq n (1- n)))) lst))) (setq blk (vla-add (vla-get-blocks AcDoc) (vlax-3d-point p) Nom-B)) (foreach n lst (vla-transformby n (UCS2WCSMatrix))) (vlax-Invoke (vla-get-activedocument (vlax-get-acad-object)) 'CopyObjects lst blk) (foreach n lst (vla-delete n)) (vla-insertblock Space (vlax-3d-point (trans p 1 0)) Nom-B 1 1 1 (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 (trans '(0 0 1) 1 0 T)))) (princ) ) ;; Doug C. Broad, Jr. ; ;; can be used with vla-transformby to ; ;; UCS2WCSMatrix transform objects from the UCS to the WCS ; (defun UCS2WCSMatrix () (vlax-tmatrix (append (mapcar '(lambda (vector origin) (append (trans vector 1 0 T) (list origin))) (list '(1 0 0) '(0 1 0) '(0 0 1)) (trans '(0 0 0) 0 1))(list '(0 0 0 1)))) ) ;;; Routine changement calque de l'objet ; (defun chang_Calque (Ob Calq) (if (not (tblobjname "LAYER" Calq)) (vla-add (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) Calq)) (vla-put-Lock (vlax-ename->vla-object (tblobjname "LAYER" Calq)) :vlax-false) ;déverouille calque (vla-put-layer (vlax-ename->vla-object Ob) Calq) )

Salut, test ça.

Salut, Juste un petit rappel en passant, et pour éviter, Didier-AD, que tu n'y passe des heures : si l'espace papier est considérer comme une fenêtre, il n'est pas possible de modifier le modifier par entmod, entmake, etc.... [Edité le 9/6/2007 par Bred]

Pour la rotation de 90 (rot90) (defun c:rot90 (/ P1 Q SEL) (command "_rotate" (setq sel (ssget)) "" (setq p1 (getpoint "\n Spécifiez le point de base :")) 90) (setq q "O") (while q (setq q (getstring "\n Continus ? ")) (if (or (equal q "")(equal q "O")) (command "_rotate" sel "" p1 90) (setq q nil) ) ) (princ) )

Salut, déjà, pour le déplacement : (defun c:Same (/ P1 P2 Q SEL) (command "_move" (setq sel (ssget)) "" (setq p1 (getpoint "\n Spécifiez le point de base :")) pause) (setq p2 (getvar "lastpoint") q "O") (while q (setq q (getstring "\n Continus ? ")) (if (or (equal q "")(equal q "O")) (command "_move" sel "" p1 p2) (setq q nil) ) ) (princ) ) Pour charger un lisp, c'est ici !. [Edité le 8/6/2007 par Bred]

Salut, J'ai le 500, et j'ai une option dans les propriétés - / - propriétés personnalisée - : "éviter mémoire insuffisante". http://xs116.xs.to/xs116/07235/2007-06-08_102903.jpg

Salut, Je ne comprends pas si ta demande consiste à tout percer ou garder l'objet "soustraiyant".... en auto-lisp pour soustraire : (command "_subtract" (ssget '((0 . "3DSOLID"))) "" (ssget '((0 . "3DSOLID"))) "") si tu veux garder le cylindre, il faut le copier/coller avant en l'enregistrant dans une variable : (setq sel (ssget '((0 . "3DSOLID"))) c (car (entsel "\n Choix de l'objet à Soustraire :"))) (vla-copy (vlax-ename->vla-object c)) (command "_subtract" sel "" c "" "") ou en vl : (setq sel (ssget '((0 . "3DSOLID")))) (foreach n (vl-remove-if 'listp (mapcar 'cadr (ssnamex sel))) (setq lst-vla-sel (append (list (vlax-ename->vla-object n)) lst-vla-sel)) ) (setq c (vlax-ename->vla-object (car (entsel "\n Choix de l'objet à Soustraire :")))) (repeat (setq x (length lst-vla-sel)) (setq c-p (vla-copy c)) (vla-boolean (nth (setq x (1- x)) lst-vla-sel) acSubtraction c-p) ) [i][b](vla-delete c)[/b][/i] [Edité le 8/6/2007 par Bred]

Salut, Va voir ici. [Edité le 8/6/2007 par Bred]

Salut, Sans le lisp nous aurions bien du mal.... Poste le !

... parceque je ne savais pas comment négocier le changement de point d'insertion simplement... et la trigo est venu à moi ... Donc, pour encadrer ou encercler des textes ou des Mtextes sur le même calque que le texte sans passer par les express : ; [b]rectxt[/b] : encadre texte (defun c:rectxt () (round-txt "R")) ; [b]circtxt[/b] : encercle texte (defun c:circtxt () (round-txt "C")) (defun round-txt (m / ACDOC E FACT HAUT I LARG LAY LST-P P1 P2 PLINE PT PTC ROT SEL) (if (= (getvar "CVPORT") 1) (setq AcDoc (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq AcDoc (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) ) (setq sel (ssget '((0 . "*TEXT")))) (repeat (setq i (sslength sel)) (setq e (entget (ssname sel (setq i (1- i)))) pt (cdr (assoc 10 e)) lay (cdr (assoc 8 e)) fact (* (cdr (assoc 40 e)) [surligneur][b]0.20[/b][/surligneur]) rot (cdr (assoc 50 e))) (if (equal (cdr (assoc 0 e)) "MTEXT") (progn (setq larg (cdr (assoc 42 e)) haut (cdr (assoc 43 e)))) (progn (setq p1 (car (textbox e)) p2 (cadr (textbox e)) larg (- (car p2) (car p1)) haut (- (cadr p2) (cadr p1)) pt (list (- (car pt) (* (sin rot) haut)) (+ (cadr pt) (* (cos rot) haut)) (caddr pt)))) ) (if (equal m "R") (progn (setq lst-p (list (- (car pt) fact)(+ (cadr pt) fact)(caddr pt) (+ (+ (car pt) larg) fact) (+ (cadr pt) fact) (caddr pt) (+ (+ (car pt) larg) fact) (- (- (cadr pt) haut) fact) (caddr pt) (- (car pt) fact) (- (- (cadr pt) haut) fact) (caddr pt)) pline (vlax-invoke AcDoc 'add3DPoly lst-p)) (vla-put-closed pline :vlax-true)) (progn (setq ptc (list (+ (car pt)(/ larg 2)) (- (cadr pt)(/ haut 2)) (caddr pt)) pline (vlax-invoke AcDoc 'addcircle ptc (/ (+ larg fact) 2)))) ) (vla-rotate pline (vlax-3D-point pt) rot) (vla-put-layer pline lay) ) )[Edité le 5/6/2007 par Bred] [Edité le 25/6/2007 par Bred]

Re, j'ai édité le code ci-dessus, il fonctionne pour la rotation.... des Mtext (pour les texte "simple", il fonctionne si il sont horizontal....) je continus à chercher ....

Alors, après ce morceau de Pain, fonctionne pour texte+mtexte, fonctionne pour la rotation des Mtext ... (defun c:rectxt (/ ACDOC E FACT HAUT I LARG LAY LST-P PLINE PMAXI PMINI PT SEL ROT) (if (= (getvar "CVPORT") 1) (setq AcDoc (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) (setq AcDoc (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)))) ) (setq sel (ssget '((0 . "*TEXT")))) (repeat (setq i (sslength sel)) (setq e (ssname sel (setq i (1- i))) pt (cdr (assoc 10 (entget e))) lay (cdr (assoc 8 (entget e))) fact (* (cdr (assoc 40 (entget e))) 0.20) rot (cdr (assoc 50 (entget e)))) (if (equal (cdr (assoc 0 (entget e))) "MTEXT") (progn (setq larg (cdr (assoc 42 (entget e))) haut (cdr (assoc 43 (entget e))))) (progn (vla-GetBoundingBox (vlax-ename->vla-object e) 'pmini 'pmaxi) (setq pt (list (car (vlax-safearray->list pmini)) (cadr (vlax-safearray->list pmaxi))(caddr (vlax-safearray->list pmini))) larg (- (car (vlax-safearray->list pmaxi)) (car (vlax-safearray->list pmini))) haut (- (cadr (vlax-safearray->list pmaxi)) (cadr (vlax-safearray->list pmini))))) ) (setq lst-p (list (- (car pt) fact)(+ (cadr pt) fact)(caddr pt) (+ (+ (car pt) larg) fact) (+ (cadr pt) fact) (caddr pt) (+ (+ (car pt) larg) fact) (- (- (cadr pt) haut) fact) (caddr pt) (- (car pt) fact) (- (- (cadr pt) haut) fact) (caddr pt)) pline (vlax-invoke AcDoc 'add3DPoly lst-p)) (vla-put-closed pline :vlax-true) (vla-put-layer pline lay) (vla-rotate pline (vlax-3D-point pt) rot) ) ) [Edité le 4/6/2007 par Bred]

Salut, avec l'aide de Patrick_35 : ; Lancer une liaison avec Excel- (defun lancer_excel (vis / sel) (setq xl (vlax-get-or-create-object "Excel.Application")) (setq wks (vlax-get xl 'Workbooks)) (vlax-for sel wks (setq liste_fichiers_ouvert (append liste_fichiers_ouvert (list (strcase (vlax-get sel 'fullname))))) ) (if (equal vis 0) (vla-put-visible xl :vlax-False) (vla-put-visible xl :vlax-True) ) ) ;;;[b] Ouverture Excel + Nom de feuille puis 1 = visible, 0 = invisible -> (XL-Ouv-Feuill "chemin fichier" "Nom de feuille") -[/b] (defun [b]XL-Ouv-Feuill[/b] (Chem-fich Nom_feuil vis) (lancer_excel vis) (setq xl-fichier (vlax-invoke wks 'open Chem-fich)) (setq xl-classeur (vlax-get xl-fichier 'sheets)) (setq x 1) (repeat (vlax-get-property xl-classeur 'Count) (if (equal (vlax-get (vlax-get-property xl-classeur 'item x) 'name) Nom_feuil) (setq xl-feuille (vlax-get-property xl-classeur 'item x)) (setq x (+ x 1)) ) ) (vlax-invoke-method xl-feuille 'Activate) ) ;;; [b]Choix Cellule dans Excel - Ecriture Texte -> (XL-Put-Txt-Cell "Texte" "C4") -[/b] (defun [b]XL-Put-Txt-Cel[/b]l (Txt Cell) (vlax-put (vlax-get-property xl-feuille 'range Cell)'value2 Txt) ) ;;; [b]Choix de Cellule dans Excel (liste) - Lire Cellule -> (XL-Get-Val-Cell '("B1" "C4")) -[/b] ;;; -> Retourne liste résultat - (defun [b]XL-Get-Val-Cell[/b] (lst-Cell / x) (setq x 0 lst-val nil) (repeat (length lst-Cell) (setq lst-val (append lst-val (list (vlax-get (vlax-get-property xl-feuille 'range (nth x lst-Cell)) 'value2))) x (+ x 1)) ) lst-val ) ;[b] Fermer la liaison avec Excel[/b] (defun [b]XL-Close[/b] (/ ok sel) (if (not (member (strcase (vlax-get xl-fichier 'fullname)) liste_fichiers_ouvert)) (vlax-invoke-method xl-fichier 'close :vlax-false) ) (if liste_fichiers_ouvert (vla-put-visible xl :vlax-True) ) (foreach sel (list xl wks xl-fichier xl-classeur xl-feuille) (vlax-release-object sel) ) (setq xl nil wks nil xl-fichier nil xl-classeur nil xl-feuille nil) (gc)(gc) ) ) [Edité le 4/6/2007 par Bred]