(gile)

Salut, Pour la régénération je n'ai jamais trouvé d'autre façon que d'affecter à une touche (F4, je ne me sers jamais de tablette) la commande regen. Sinon, pour la molette qui s'arrête de fonctionner, j'ai lu quelque part, mais impossible de retrouver où, qu'il suffisait de faire marcher la molette en mettant le pointeur hors de la fenêtre d'AutoCAD pour que le fonctionnement redevienne normal.

Re, Pour ce que propose gi², un mtext de largeur 0, il y a un excellent LISP de _zebulon ici.

Pour JL, Merci pour le compliment :red: mais sans la nouvelle commande LISSAGE (_LOFT), on était bien obligé de bidouiller, une grande partie du "mérite" revient donc aux développeurs d'AutoCAD. Pour Concombre_masque, Si aujourd'hui certains limons, et sûrement aussi des mains courantes, sont d'abord construites (ébauchées) en lamellé-collé, il est toujours nécessaire d'usiner les "bois croches". Traditionnellement les limons et les mains courantes sont usinées dans la masse en plusieurs tronçons pour rester le maximum "dans le fil" et assemblés ensuite. Le profilage des parties croches des mains courantes s'effectue à la toupie, "au champignon", c'est en partie ce genre d'opération, qui ne peut se faire que sans réelle protection, qui a valu à la toupie sa réputation (pas complètement usurpée) de machine dangereuse, et qui a coûté des doigts à beaucoup de menuisier (je n'ai, pour ma part, jamais fait de toupillage "au champignon". Mais peut-être que JL qui, lui, pratique la contruction d'escalier courbes pourra t'en dire un peu plus (et corrigé les éventuelles bétises que j'aurais dites).

Salut, Je ne suis pas sûr de comprendre ce que tu veux dire par "vérouiller". La largeur d'un texte multiligne est contenue dans le code DXF 41. En LISP, pour changer la largeur d'un texte multiligne existant, on peut faire : (setq ent (car (entsel "\nSélectionner le texte multiligne: ")) e_lst (entget ent) ) (initget 7) (setq larg (getdist "\nSpécifiez la nouvelle largeur: ")) (cond ((= (cdr (assoc 0 e_lst)) "MTEXT") (setq e_lst (subst (cons 41 larg) (assoc 41 e_lst) e_lst)) (entmod e_lst) (entupd ent) ) ) [Edité le 2/8/2006 par (gile)]

Voilà le LISP est abondamment commenté, j'ai essayé d'écrire le plus possible en VisualLISP pour que la traduction en VBA soit plus "facile" (pour Culnuteurdebase).

Le LISP ci-dessus était incomplet (les sous routines avaient échappé au copier/coller), c'est réparé, toutes mes excuses. PS : Je vais tacher d'y ajouter des commentaires ...

DWF ou PDF sont des formats de fichier comme DWG , DOC ou XLS (respectivement les fichiers AutoCAD, Word et Excel). Les fichiers DWF ou PDF sont des fichiers auquels on peut accéder avec des logiciels gratuits (Adobe Reader et DWF Viewer) sans pouvoir les modifier. Pour créer de tels fichiers avec AutoCAD on utilise des "imprimantes virtuelles" qui au lieu d'imprimer sur du papier , génèrent des fichiers. Pour faire des fichiers DWF, l'imprimante est intégrée à AutoCAD, tu y accède par la commande PUBLIER ou en choisissant l'imprimante DWF6 ePlot.pc3 dans le gestionnaire de traçage. Pour créer des fichier PDF il faut télécharger et installer une "imprimante", PDFCreator par exemple et ensuite choisir cette imprimante dans le gestionnaire de traçage. Pour en savoir plus sur le PDF vois ici. Et sur le DWF ici ou la, par exemple. [Edité le 1/8/2006 par (gile)]

Salut et bienvenue, tu peux faire des DWF à partir de tes présentations, l'autre personne pourra les voir et les imprimer après avoir téléchargé et installé DWF Viewer, un logiciel gratuit de chez Autodesk, tu peux aussi faire du PDF avec l'imprimante virtuelle PDFCreator (gratuit aussi), fais une recherche dans les forums, le sujet a souvent été abordé.

Le "pro" ça veut dire que c'est rémunérateur, non ? Malheureusement, ce n'est toujours pas le cas, bientôt, j'espère. Plus sérieusement, merci pour le compliment et les encouragements, et aussi pour le retour, je suis content que ça marche. :D

Salut, Pour la lumière du soleil, tu peux voir ici et le reste du sujet pour les questions de rendus avec 2007, tout le monde "découvre" les nouveautés, avec des bonnes et des moins bonnes surprises !

800x600http://img472.imageshack.us/img472/1697/maincourantegb5.png [/img]

Voici un LISP qui permet de faire de solides ou des surfaces débillardés avec la version 2007. Le LISP répartit des "coupes" sur le chemin spécifié et fait un lissage suivant ces coupes et ce chemin. La "coupe" doit être une entité 2D unique composant d'un bloc. Attention au moment de la création du bloc à l'orientation de l'entité par rapport au SCU, c'est l'axe des X du SCO du bloc qui tangentera avec la projection du chemin sur le plan XY du SCU courant. http://img476.imageshack.us/img476/1049/debil1rh6.png Après avoir sélectionné le bloc dans la liste déroulante, spécifé le chemin et le nombre de coupes, les blocs sont insérés et explosés et sélectionnés dans l'ordre pour le lissage : http://img149.imageshack.us/img149/1576/debil2ky2.png http://img149.imageshack.us/img149/6776/debil3qs8.png ;;; C:DEBIL (gile) ;;; Crée un solide ou une surface "débillardé" à partir d'un profil de coupe ;;; et d'un chemin. ;;; Le profil doit être une unique entité 2D contenue dans un bloc. ;;; Loft_along_path Créé un lissage d'après une liste de coupes et un chemin ;;; Fonctionne avec COMMAND dans l'attente d'une fonction vla-... (defun loft_along_path (lst path / echo) (setq echo (getvar "CMDECHO")) (grtext -2 "Création du lissage en cours.") (setvar "CMDECHO" 0) (command "_.loft") (mapcar 'command lst) (command "" "_path" path) (setvar "CMDECHO" echo) ) ;;; Fonction principale (defun c:debil (/ Space *error* ucszdir nom sect path nb obj dist ins_pt deriv1 ref lst ) (vl-load-com) (or *acad* (setq *acad* (vlax-get-acad-object))) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument *acad*))) (defun *error* (msg) (if (or (= msg "Fonction annulée") (= msg "quitter / sortir abandon") ) (princ) (princ (strcat "\nErreur: " msg)) ) (vla-endundomark *acdoc*) (princ) ) (setq Space (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace *acdoc*) (vla-get-ModelSpace *acdoc*) ) ucszdir (trans '(0 0 1) 1 0 T) ) (sssetfirst nil nil) (vla-StartUndoMark *acdoc*) (if (setq nom (getblock nil)) (if (and (setq bloc_def (vla-Item (vla-get-Blocks *acdoc*) nom)) (= (vla-get-Count bloc_def) 1) (or (member (vla-get-ObjectName (setq sect (vla-Item bloc_def 0))) '("AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbLine" "AcDbPolyline" "AcDb2dPolyline" ) ) (and (= (vla-get-ObjectName sect) "AcDbSpline") (= :vlax-true (vla-get-isPlanar sect)) ) ) ) (progn (while (not (and (setq path (car (entsel "\nChoix du chemin: ")) obj (vlax-ename->vla-object path) ) (not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list obj) ) ) ) ) ) ) (initget 7) (setq nb (getint "\nEntrez le nombre de coupes: ")) (setq dist (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) nb ) ) (repeat (setq nb (1- nb)) (setq ins_pt (vlax-curve-getPointAtDist obj (* nb dist))) (setq deriv1 (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtDist obj (* nb dist)) ) ) (setq ref (vla-InsertBlock Space (vlax-3d-point ins_pt) nom 1 1 1 (angle '(0 0 0) (trans deriv1 0 ucszdir)) ) ) (setq lst (append (vlax-invoke ref 'explode) lst)) (vla-delete ref) (setq nb (1- nb)) ) (setq ins_pt (vlax-curve-getStartPoint obj) deriv1 (vlax-curve-getFirstDeriv obj (vlax-curve-getStartParam obj) ) ) (setq ref (vla-InsertBlock Space (vlax-3d-point ins_pt) nom 1 1 1 (angle '(0 0 0) (trans deriv1 0 ucszdir)) ) ) (setq lst (append (vlax-invoke ref 'explode) lst)) (vla-delete ref) (if (or (member (vla-get-Objectname obj) '("AcDbArc" "AcDbHelix" "AcDbLine") ) (and (= (vla-get-Objectname obj) "AcDbEllipse") (or (/= (vla-get-StartAngle obj) 0.0) (/= (vla-get-EndAngle obj) (* 2 pi)) ) ) (and (member (vla-get-Objectname obj) '("AcDbPolyline" "AcDb2dPolyline" "AcDb3dPolyline" "AcDbSpline" ) ) (and (= :vlax-false (vla-get-Closed obj)) (not (equal (vlax-curve-getStartPoint obj) (vlax-curve-getEndPoint obj) 1e-9 ) ) ) ) ) (progn (setq ins_pt (vlax-curve-getEndPoint obj) deriv1 (vlax-curve-getFirstDeriv obj (vlax-curve-getEndParam obj) ) ) (setq ref (vla-InsertBlock Space (vlax-3d-point ins_pt) nom 1 1 1 (angle '(0 0 0) (trans deriv1 0 ucszdir)) ) ) (setq lst (append lst (vlax-invoke ref 'explode)) ) (vla-delete ref) ) ) (if (<= 17 (read (substr (getvar "ACADVER") 1 4))) (loft_along_path (mapcar 'vlax-vla-object->ename lst) path) (alert "La commande LISSAGE (_LOFT) n'est pas accessible aux versions antérieures à 2007" ) ) (setvar "INSNAME" nom) ) (prompt "\nLe bloc ne doit contenir qu'une seule entité 2D." ) ) ) (vla-EndUndoMark *acdoc*) (princ) ) ;;; Getblock (gile) 03/11/07 ;;; Retourne le nom du bloc entré ou choisi par l'utilisateur ;;; dans une liste déroulante de la boite de dialogue ou depuis la boite ;;; de dialogue standard d'AutoCAD ;;; Argument : le titre (string) ou nil (défaut : "Choisir un bloc") (defun getblock (titre / bloc n lst tmp file what_next dcl_id nom) (while (setq bloc (tblnext "BLOCK" (not bloc))) (setq lst (cons (cdr (assoc 2 bloc)) lst) ) ) (setq lst (acad_strlsort (vl-remove-if (function (lambda (n) (= (substr n 1 1) "*"))) lst ) ) tmp (vl-filename-mktemp "Tmp.dcl") file (open tmp "w") ) (write-line (strcat "getblock:dialog{label=" (cond (titre (vl-prin1-to-string titre)) ("\"Choisir un bloc\"") ) ";initial_focus=\"bl\";:boxed_column{ :row{:text{label=\"Sélectionner\";alignment=left;} :button{label=\">>\";key=\"sel\";alignment=right;fixed_width=true;}} spacer; :column{:button{label=\"Parcourir...\";key=\"wbl\";alignment=right;fixed_width=true;}} :column{:text{label=\"Nom :\";alignment=left;}} :edit_box{key=\"tp\";edit_width=25;} :popup_list{key=\"bl\";edit_width=25;}spacer;} spacer; ok_cancel;}" ) file ) (close file) (setq dcl_id (load_dialog tmp)) (setq what_next 2) (while (>= what_next 2) (if (not (new_dialog "getblock" dcl_id)) (exit) ) (start_list "bl") (mapcar 'add_list lst) (end_list) (if (setq n (vl-position (strcase (getvar "INSNAME")) (mapcar 'strcase lst) ) ) (setq nom (nth n lst)) (setq nom (car lst) n 0 ) ) (set_tile "bl" (itoa n)) (action_tile "sel" "(done_dialog 5)") (action_tile "bl" "(setq nom (nth (atoi $value) lst))") (action_tile "wbl" "(done_dialog 3)") (action_tile "tp" "(setq nom $value) (done_dialog 4)") (action_tile "accept" "(setq nom (nth (atoi (get_tile \"bl\")) lst)) (done_dialog 1)" ) (setq what_next (start_dialog)) (cond ((= what_next 3) (if (setq nom (getfiled "Sélectionner un fichier" "" "dwg" 0)) (setq what_next 1) (setq what_next 2) ) ) ((= what_next 4) (cond ((not (read nom)) (setq what_next 2) ) ((tblsearch "BLOCK" nom) (setq what_next 1) ) ((findfile (setq nom (strcat nom ".dwg"))) (setq what_next 1) ) (T (alert (strcat "Le fichier \"" nom "\" est introuvable.")) (setq nom nil what_next 2 ) ) ) ) ((= what_next 5) (if (and (setq ent (car (entsel))) (= "INSERT" (cdr (assoc 0 (entget ent)))) ) (setq nom (cdr (assoc 2 (entget ent))) what_next 1 ) (setq what_next 2) ) ) ((= what_next 0) (setq nom nil) ) ) ) (unload_dialog dcl_id) (vl-file-delete tmp) nom ) EDIT : J'ai ajouté un test sur la version d'AutoCAD pour que ceux qui 'ont pas AutoCAD 2007 puissent tester. Ils n'auront que l'insertion/décomposition du bloc et un message d'alerte à la place du lissage. Un résultat similaire, sans décomposition ni insertion aux extrémités est possible avec Dviser3d, et les options Aligner : Oui, Plan de référence : Scu. Et puisqu'il est question de main courante d'escalier : http://img314.imageshack.us/img314/4615/maincourantejy2.png [Edité le 1/8/2006 par (gile)][Edité le 2/8/2006 par (gile)][Edité le 2/8/2006 par (gile)] [Edité le 25/7/2008 par (gile)]

Pas tout à fait nul ;) Dans le même SCU (non parallèle au SCG), sur la même polyligne 2D (créée dans un autre SCU non parallèle au SCG), avec AutoCAD 2007: Et le point est correctement placé, celà va sans dire. ;) [Edité le 1/8/2006 par (gile)]

Salut, J'ai aussi réussi à mettre en défaut le code que je donnais, il semble que l'erreur vienne de la "traduction" du vecteur retourné par VIEWDIR du SCU vers le SCG. Il me semble avoir trouvé la solution : (setq ent (entsel)) (setq pick (vlax-curve-getClosestPointToProjection (setq obj (vlax-ename->vla-object (car ent))) (trans (cadr ent) 1 0) (mapcar '- (trans (getvar "viewdir") 1 0) (trans '(0 0 0) 1 0)) ) )

Salut, Je te propose d'essayer avec un petit LISP, je ne suis pas sûr du résultat si les codes "ascii" ont changé. Donc, dans un premier temps, copie/colle le LISP suivant sur la ligne de commande et fait "ENTER" puis sélectionne un texte incriminé. ((lambda (/ ent e_lst) (command "_.undo" "_begin") (setq ent (car (entsel)) e_lst (entget ent) c_lst (vl-string->list (cdr (assoc 1 e_lst))) ) (foreach pair '((224 211) (233 218) (176 221)) (setq c_lst (subst (car pair) (cadr pair) c_lst)) ) (setq e_lst (subst (cons 1 (vl-list->string c_lst)) (assoc 1 e_lst) e_lst)) (entmod e_lst) (command "_.undo" "_end") (princ) ) ) Si le résultat n'est pas celui espéré, tu peux faire "Annuler", sinon tu peux refaire la même opération avec le code suivant pour modifier en une seule fois tous les textes sur les calque non-vérouillés. ((lambda (/ ss ent e_lst) (command "_.undo" "_begin") (setq ss (ssget "_X" '((0 . "*TEXT")))) (repeat (setq n (sslength ss)) (setq ent (ssname ss (setq n (1- n))) e_lst (entget ent) c_lst (vl-string->list (cdr (assoc 1 e_lst))) ) (foreach pair '((224 211) (233 218) (176 221)) (setq c_lst (subst (car pair) (cadr pair) c_lst)) ) (setq e_lst (subst (cons 1 (vl-list->string c_lst)) (assoc 1 e_lst) e_lst ) ) (entmod e_lst) ) (command "_.undo" "_end") (princ) ) ) PS: les LISP ci dessus ne corrigent que Ý, Ú et Ó, si ça marche et que tu as d'autres caractères à modifier signale moi les.

Je pense que tu as du trouver depuis, mais je te livre un moyen que j'ai trouvé et qui semble bien fonctionner (à lancer à la suite du (entsel ...) pour qu'il n'y ait pas de risque que l'utilisateur change la vue entre temps). (setq ent (entsel)) (setq pick (vlax-curve-getClosestPointToProjection (setq obj (vlax-ename->vla-object (car ent))) (trans (cadr ent) 1 0) (trans (getvar "viewdir") ucszdir 0) ) )

Le LISP est encore amélioré, il ne reste que l'insertion de bloc sur les lignes et polylignes 3D avec l'option "Objet" pour le plan de référence qui peuvent produire des résultats pas très cohérents en ce qui concene le plan de référence, justement.

Salut, Tu enregistres le fichier : le_nom_que_tu_veux.lsp Puis, - soit tu le fais glisser directment de l'explorer vers la fenêtre d'AutoCAD, - soit tu tapes APPLOAD et tu charges le fichier (tu peux le mettre dans la "valise" Au démarrage si tu veux qu'il soit chargé à chaque démarrage d'AutoCAD), - soit tu copies le code dans ton fichier .MNL courant (acd.mnl par défaut) ou dans le fichier AutoCAD.lsp ou acaddoc.lsp, - soit, si le fichier est enrgistré dans un dossier du chemin de recherche des fichiers de support, tu tapes (load "le_nom_que_tu_veux.lsp"), ou tu ajoutes cette ligne dans le fichier .MNL ou encore (autoload "le_nom_que_tu_veux.lsp" '("diviser3d" "mesurer3d")) qui ne chargeras le LISP que quand tu taperas mesurer3d ou diviser3d à la ligne de commande... Attention, il est possible qu'il y ait des modifications, la programmation en 3D n'est pas évidente pour moi, il reste peut-être des "bugs" (voir la date et l'heure de la version).

Il y avait encore un bug dans le LISP avec les lignes et les portions droites de polyligne (dérivée seconde = (0.0 0.0 0.0). Je pense l'avoir réparé. Merci de me prévenir en cas de dysfonctionnements.

Les commandes DIVSER et MESURER n'ont pas un comportement très rigoureux en 3D suivant le type d'entité sélectionné (notamment avec les ellipses) et le SCU courant. Petits exemples illustrés : Dans le SCU (non parallèle au SCG) dans lequel a été créée l'ellipse, les blocs s'insèrent suivant le SCG et à côté de l'ellipse. http://img143.imageshack.us/img143/3073/diviser5wq9.png Dans un SCU (non parallèle au SCG) différent de celui dans lequel ont été créées l'ellipse et le cercle, les blocs s'insèrent suivant le SCU sur l'ellipse et suivant l'objet sur le cercle. http://img154.imageshack.us/img154/9682/diviser4my3.png

J'ai amélioré la routine ci dessus, il est désormais possible de spécifier si le bloc doit être inséré par rapport au plan XY du SCU courant ou par rapport au plan de l'objet. http://img153.imageshack.us/img153/8263/diviserfg4.png J'ai réparé un bug avec les splines, le bloc s'insérait à l'envers suivant la concavité ou convexité de la spline. http://img163.imageshack.us/img163/4883/diviser2dg5.png [Edité le 30/7/2006 par (gile)]

Salut, Tu peux voir ce sujet.

Salut à vous, Voici un LISP qui devrait répondre à quelques demandes ici exprimées. D'après les tests que j'ai fait, les commandes DIVISER3D et MESURER3D fonctionnent comme DIVISER et MESURER, avec en plus : - un comportement en 3D qui devrait plus plaire à Tramber (si j'ai bien compris la demande), - une boite de dialogue pour Rebcao, - l'affichage de la longueur de l'objet pour Tramber et Jalna. Version du 01/08/06 11h00 Le fichier DCL à enregistrer sous getblock.dcl dans un dossier du chemin de recherche des fichiers de support. getblock:dialog{ label="Sélection de bloc"; initial_focus="bl"; :boxed_column{ label="Choisissez un bloc"; :popup_list{ key="bl"; edit_width=30; } } ok_cancel; } et les routines LISP qui vont avec : ;;; DIVISER3D et MESURER3D - Gilles Chanteau - 31/07/06 ;;; ;;; Fonctionnement similaire aux commandes DIVISER (_DIVIDE) et MESURER (__MEASURE) ;;; Les plus : ;;; - L'option "Bloc" permet l'insertion de bloc sur des objets 2D quels que soient ;;; le SCO de l'objet et le SCU courant. ;;; - Une option supplémentaire : "Plan de référence pour l'insertion du bloc ?" ;;; permet de choisir si le bloc est inséré par rapport au plan XY du SCU courant ;;; (Scu) ou par rapport à l'objet (Objet). ;;; - Le choix du bloc se fait dans la liste déroulante d'une boite de dialogue. ;;; - La longueur de l'objet sélectionnée est affichée sur la ligne de commande. ;;; Getspace Retourne l'espace courant (Modèle ou Papier) (defun getSpace () (if (= (getvar "CVPORT") 1) (vla-get-PaperSpace (vla-get-ActiveDocument (vlax-get-acad-object)) ) (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object)) ) ) ) ;;; Getblock Retourne le nom du bloc choisi par l'utilisateur dans une ;;; liste déroulante de la boite de dialogue définie dans Getblock.dcl (defun getblock (/ bloc lst dcl_id nom) (setq bloc (tblnext "BLOCK" T)) (while bloc (setq lst (cons (cdr (assoc 2 bloc)) lst) bloc (tblnext "BLOCK") ) ) (setq lst (acad_strlsort lst)) (setq dcl_id (load_dialog "Getblock.dcl")) (if (not (new_dialog "getblock" dcl_id)) (exit) ) (start_list "bl") (mapcar 'add_list lst) (end_list) (action_tile "accept" (strcat "(progn" "(setq nom (nth (atoi (get_tile \"bl\")) lst)))" "(done_dialog))" ) ) (start_dialog) (unload_dialog dcl_id) nom ) ;;; NORM_3PTS retourne le vecteur normal du plan défini par 3 points (defun norm_3pts (p0 p1 p2 / norm) (cond ((inters p0 p1 p0 p2) (foreach p '(p1 p2) (set p (mapcar '- (eval p) p0)) ) (setq norm (list (- (* (cadr p1) (caddr p2)) (* (caddr p1) (cadr p2))) (- (* (caddr p1) (car p2)) (* (car p1) (caddr p2))) (- (* (car p1) (cadr p2)) (* (cadr p1) (car p2))) ) norm (mapcar '(lambda (x) (* x (/ 1 (distance '(0 0 0) norm)))) norm ) ) ) ) ) ;;; Std_vl_err Redéfinition de *error* (defun std_vl_err (msg) (if (= msg "Fonction annulée") (princ) (princ (strcat "\nErreur: " msg)) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (setq *error* m:err m:err nil ) (princ) ) ;;; Diviser3D (defun c:diviser3D (/ AcDoc Space ucszdir ent obj pick long nb nom algn scu dist ins_pt deriv1 deriv2 ang norm ref ) (vl-load-com) (setq m:err *error* *error* std_vl_err ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (getSpace) ucszdir (trans '(0 0 1) 1 0 T) ) (sssetfirst nil nil) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-getEntity (list (vla-get-Utility AcDoc) 'obj 'pick "\nChoix de l'objet à diviser: " ) ) ) (prompt "*Incorrect*") (progn (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list obj)) ) (prompt "\nL'objet ne peut pas être divisé.*Incorrect*") (progn (setq long (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (prompt (strcat "\nLongueur de l'objet: " (rtos long))) (while (not (> 3268 nb 1)) (initget "Bloc") (setq nb (getint "\nEntrez le nombre de segments ou [bloc]: ") ) (if (numberp nb) (if (not (> 3268 nb 1)) (prompt "\nNécessite un entier entre 2 et 32767, ou une option." ) ) ) (if (= nb "Bloc") (progn (setq nom (getblock)) (if nom (setq nb 2) (setq nb 0) ) ) ) ) (if nom (progn (initget "Oui Non") (setq algn (getkword "\nAligner le bloc avec l'objet ? [Oui/Non] : " ) nb 0 ) (initget "Objet Scu") (setq scu (getkword "\nPlan de référence pour l'insertion du bloc ? [Objet/Scu] : " ) ) (while (not (> 3268 nb 1)) (setq nb (getint "\nEntrez le nombre de segments: ")) (if (not (> 3268 nb 1)) (prompt "\nNécessite un entier entre 2 et 32767." ) ) ) ) ) (setq dist (/ long nb)) (vla-StartUndoMark AcDoc) (repeat (setq nb (1- nb)) (setq ins_pt (vlax-curve-getPointAtDist obj (* nb dist)) deriv1 (vlax-curve-getFirstDeriv obj (vlax-curve-getParamAtDist obj (* nb dist)) ) ) (if (/= scu "Scu") (cond ((member (vla-get-ObjectName obj) '("AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbPolyline" "AcDb2dPolyline" ) ) (setq norm (vlax-safearray->list (vlax-variant-value (vla-get-Normal obj)) ) ) ) (T (setq deriv2 (vlax-curve-getSecondDeriv obj (vlax-curve-getParamAtDist obj (* nb dist)) ) ) (if (equal '(0 0 0) deriv2) (setq deriv2 (trans (polar '(0 0 0) (+ (angle (trans '(0 0 0) 0 (vlax-vla-object->ename obj) ) (trans deriv1 0 (vlax-vla-object->ename obj) ) ) (/ pi 2) ) 1.0 ) (vlax-vla-object->ename obj) 0 ) ) ) (setq ang (- (angle '(0 0 0) deriv2) (angle '(0 0 0) deriv1)) ) (if (minusp ang) (setq ang (+ ang (* 2 pi))) ) (if ( (setq norm (norm_3pts '(0 0 0) deriv1 deriv2)) (setq norm (norm_3pts '(0 0 0) deriv2 deriv1)) ) ) ) ) (if nom (if (= scu "Scu") (vla-InsertBlock Space (vlax-3d-point ins_pt) nom 1 1 1 (if (= algn "Non") (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 ucszdir) ) (angle '(0 0 0) (trans deriv1 0 ucszdir)) ) ) (progn (setq ref (vla-InsertBlock Space (vlax-3d-point '(0 0 0)) nom 1 1 1 0 ) ) (vla-put-Normal ref (vlax-3d-Point norm)) (vla-Move ref (vlax-3d-point '(0 0 0)) (vlax-3d-point ins_pt) ) (vla-Rotate3d ref (vlax-3d-point ins_pt) (vlax-3d-point (mapcar '+ ins_pt norm)) (if (= algn "Non") (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 norm)) (angle '(0 0 0) (trans deriv1 0 norm)) ) ) ) ) (vla-addPoint Space (vlax-3d-point (vlax-curve-getPointAtDist obj (* nb dist)) ) ) ) (setq nb (1- nb)) ) (if (vlax-curve-isClosed obj) (progn (setq ins_pt (vlax-curve-getStartPoint obj) deriv1 (vlax-curve-getFirstDeriv obj (vlax-curve-getStartParam obj) ) ) (if (/= scu "Scu") (cond ((member (vla-get-ObjectName obj) '("AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbPolyline" "AcDb2dPolyline" ) ) (setq norm (vlax-safearray->list (vlax-variant-value (vla-get-Normal obj)) ) ) ) (T (setq deriv2 (vlax-curve-getSecondDeriv obj (vlax-curve-getParamAtDist obj (* nb dist)) ) ) (if (equal '(0 0 0) deriv2) (setq deriv2 (trans (polar '(0 0 0) (+ (angle (trans '(0 0 0) 0 (vlax-vla-object->ename obj) ) (trans deriv1 0 (vlax-vla-object->ename obj) ) ) (/ pi 2) ) 1.0 ) (vlax-vla-object->ename obj) 0 ) ) ) (setq ang (- (angle '(0 0 0) deriv2) (angle '(0 0 0) deriv1)) ) (if (minusp ang) (setq ang (+ ang (* 2 pi))) ) (if ( (setq norm (norm_3pts '(0 0 0) deriv1 deriv2)) (setq norm (norm_3pts '(0 0 0) deriv2 deriv1)) ) ) ) ) (if nom (if (= scu "Scu") (vla-InsertBlock Space (vlax-3d-point ins_pt) nom 1 1 1 (if (= algn "Non") (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 ucszdir) ) (angle '(0 0 0) (trans deriv1 0 ucszdir)) ) ) (progn (setq ref (vla-InsertBlock Space (vlax-3d-point '(0 0 0)) nom 1 1 1 0 ) ) (vla-put-Normal ref (vlax-3d-Point norm)) (vla-Move ref (vlax-3d-point '(0 0 0)) (vlax-3d-point ins_pt) ) (vla-Rotate3d ref (vlax-3d-point ins_pt) (vlax-3d-point (mapcar '+ ins_pt norm)) (if (= algn "Non") (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 norm) ) (angle '(0 0 0) (trans deriv1 0 norm)) ) ) ) ) (vla-addPoint Space (vlax-3d-point (vlax-curve-getPointAtDist obj (* nb dist)) ) ) ) ) ) (vla-EndUndoMark AcDoc) ) ) ) ) (setq *error* m:err m:err nil ) (princ) ) ;;; Mesurer3D (defun c:mesurer3D (/ AcDoc Space ucszdir obj pick long dist nom algn scu nb rest ins_pt deriv1 deriv2 ang norm ref ) (vl-load-com) (setq m:err *error* *error* std_vl_err ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (getSpace) ucszdir (trans '(0 0 1) 1 0 T) ) (sssetfirst nil nil) (if (vl-catch-all-error-p (vl-catch-all-apply 'vla-getEntity (list (vla-get-Utility AcDoc) 'obj 'pick "\nChoix de l'objet à mesurer: " ) ) ) (prompt "*Incorrect*") (progn (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getEndParam (list obj)) ) (prompt "\nL'objet ne peut pas être mesuré.*Incorrect*") (progn (setq pick (vlax-curve-getClosestPointToProjection obj (trans (vlax-SafeArray->list pick) 1 0) (mapcar '- (trans (getvar "viewdir") 1 0) (trans '(0 0 0) 1 0)) ) long (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (prompt (strcat "\nLongueur de l'objet: " (rtos long))) (while (and (not (numberp dist)) (not nom)) (initget 7 "Bloc") (setq dist (getint "\nSpécifiez la longueur du segment ou [bloc]: ") ) (if (= dist "Bloc") (setq nom (getblock)) ) ) (if nom (progn (initget "Oui Non") (setq algn (getkword "\nAligner le bloc avec l'objet ? [Oui/Non] : " ) ) (initget "Objet Scu") (setq scu (getkword "\nPlan de référence pour l'insertion du bloc ? [Objet/Scu] : " ) ) (initget 7) (setq dist (getdist "\nSpécifiez la longueur du segment: ") ) ) ) (if ( (prompt "\nL'objet n'est pas assez long.") (progn (setq nb (fix (/ long dist))) (if ( (setq rest (rem long dist)) (setq rest nil) ) (vla-StartUndoMark AcDoc) (repeat nb (setq ins_pt (if rest (vlax-curve-getPointAtDist obj (+ (* (1- nb) dist) rest) ) (vlax-curve-getPointAtDist obj (* nb dist)) ) deriv1 (vlax-curve-getFirstDeriv obj (if rest (vlax-curve-getParamAtDist obj (+ (* (1- nb) dist) rest) ) (vlax-curve-getParamAtDist obj (* nb dist)) ) ) ) (if (/= scu "Scu") (cond ((member (vla-get-ObjectName obj) '("AcDbArc" "AcDbCircle" "AcDbEllipse" "AcDbPolyline" "AcDb2dPolyline" ) ) (setq norm (vlax-safearray->list (vlax-variant-value (vla-get-Normal obj)) ) ) ) (T (setq deriv2 (vlax-curve-getSecondDeriv obj (if rest (vlax-curve-getParamAtDist obj (+ (* (1- nb) dist) rest) ) (vlax-curve-getParamAtDist obj (* nb dist)) ) ) ) (if (equal '(0 0 0) deriv2) (setq deriv2 (trans (polar '(0 0 0) (+ (angle (trans '(0 0 0) 0 (vlax-vla-object->ename obj) ) (trans deriv1 0 (vlax-vla-object->ename obj) ) ) (/ pi 2) ) 1.0 ) (vlax-vla-object->ename obj) 0 ) ) ) (setq ang (- (angle '(0 0 0) deriv2) (angle '(0 0 0) deriv1) ) ) (if (minusp ang) (setq ang (+ ang (* 2 pi))) ) (if ( (setq norm (norm_3pts '(0 0 0) deriv1 deriv2)) (setq norm (norm_3pts '(0 0 0) deriv2 deriv1)) ) ) ) ) (if nom (if (= scu "Scu") (vla-InsertBlock Space (vlax-3d-point ins_pt) nom 1 1 1 (if (= algn "Non") (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 ucszdir) ) (angle '(0 0 0) (trans deriv1 0 ucszdir)) ) ) (progn (setq ref (vla-InsertBlock Space (vlax-3d-point '(0 0 0)) nom 1 1 1 0 ) ) (vla-put-Normal ref (vlax-3d-Point norm)) (vla-Move ref (vlax-3d-point '(0 0 0)) (vlax-3d-point ins_pt) ) (vla-Rotate3d ref (vlax-3d-point ins_pt) (vlax-3d-point (mapcar '+ ins_pt norm)) (if (= algn "Non") (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 norm) ) (angle '(0 0 0) (trans deriv1 0 norm)) ) ) ) ) (vla-addPoint Space (vlax-3d-point ins_pt)) ) (setq nb (1- nb)) ) (vla-EndUndoMark AcDoc) ) ) ) ) ) ) (setq *error* m:err m:err nil ) (princ) )[Edité le 30/7/2006 par (gile)][Edité le 30/7/2006 par (gile)][Edité le 31/7/2006 par (gile)][Edité le 31/7/2006 par (gile)] [Edité le 1/8/2006 par (gile)]

Si j'ai bien compris la question première de Bred, la routine suivante retourne, dans la fenêtre de texte d'AutoCAD, les coordonnées dans le SCU des points d'insertion du "sous-bloc" spécifié dans la référence de bloc parent sélectionnée. Si le bloc "enfant" est imbriqué plusieurs fois dans le bloc "parent", les différentes insertions sont retournées. (defun c:NestedInRef (/ nest n_lst ref) (setq nest "") (while (not (tblsearch "Block" nest)) (setq nest (getstring "\nEntrez le nom du bloc recherché: ")) ) (prompt (strcat "\nSélectionnez la référence de bloc dans laquelle on recherche \"" nest "\"." ) ) (while (not (setq ref (ssget "_:S:E" '((0 . "INSERT")))))) (setq ref (ssname ref 0) r_lst (entget ref) n_lst (nested_coord nest) ) (if (assoc (cdr (assoc 2 r_lst)) n_lst) (progn (setq c_lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) (cdr (assoc 2 r_lst)))) n_lst ) ) c_lst (mapcar '(lambda (x) (setq x (list (* (car x) (cdr (assoc 41 r_lst))) (* (cadr x) (cdr (assoc 42 r_lst))) (* (caddr x) (cdr (assoc 43 r_lst))) ) x (polar '(0 0 0) (+ (angle '(0 0 0) x) (cdr (assoc 50 r_lst)) ) (distance '(0 0 0) x) ) x (trans (mapcar '+ (cdr (assoc 10 r_lst)) x ) ref 1 ) ) ) c_lst ) ) (princ (strcat "\nLe bloc \"" nest "\" est inséré en : ")) (mapcar 'print c_lst) ) (prompt (strcat "\nAucne imbrication du bloc \"" nest "\" dans le bloc \"" (cdr (assoc 2 r_lst)) "\"." ) ) ) (textscr) (princ) ) PS : pour ne pas avoir de souci avec la casse du nom de bloc entré, il suffit de remplacer, dans NESTED_COORD la ligne : (= (cdr (assoc 2 (entget ent))) (caar temp_lst)) par : (= (strcase (cdr (assoc 2 (entget ent)))) (strcase (caar temp_lst)))

Salut et merci, Je crois que nous sommes "voisins", j'habite Marseille, peut -être une rencontre moins virtuelle un de ces jours ...