-
Compteur de contenus
5 029 -
Inscription
-
Dernière visite
-
Jours gagnés
56
Type de contenu
Profils
Forums
Calendrier
Blogs
Tout ce qui a été posté par bonuscad
-
J'ai comme l'impression que cette routine n'est pas le code d'origine, que celui ci a été détourné de sa fonction première pour en faire une identification de déblais remblai. Personnellement je vois pas comment ce code pourrait effectuer cela d'une façon fiable. Sachant que les barbule sont toujours dessinés dans le sens haut de talus vers bas de talus, je vois pas comment identifier (en récupérant la pente de celles-ci qui logiquement sera toujours du haut vers le bas) si c'est du remblais ou du déblai... Pour moi avec ce code c'est mission impossible. La seule chose qui serait faisable c'est en identifiant l'axe de référence pour déterminer la position 2D des extrémités des barbules par rapport à celui-ci (quel est le plus proche de l'axe, le point haut ou le point bas de la barbule?). Cela serait déjà un peu plus fiable pour les cas simple, mais en cas de merlon par exemple il y aurait encore de mauvaise interprétation.
-
Lisp exitant US GetVector
bonuscad a répondu à un(e) sujet de tyrese69_ dans Pour aller plus loin en LISP
Bonjour, Sans méchanceté, si tu n'arrives pas à le traduire, je doute que tu arrives à l'utiliser... Ce programme est destiné à des programmeurs voulant inclure une image (fabriqué depuis des entités d'Autocad) dans une boite de dialogue. Je te l'ai quand même traduit (testé rapidement pour voir si je n'avais rien oublié lors de la traduction, mais pas testé l'intégration dans une conception de boite de dialogue) GetVectors.lsp GetVectors.dcl -
Ouvert le dessin, pas de problème de sélection sur les textes désignés... Par contre un _AUDIT me révèle pas moins de 88 erreurs sur essentiellement des "AcDbMText" Donc un CONTROLE avec correction pourrait déjà peut être corriger ton problème.
-
A première vue, je dirais qu'il y a un fichier qui est chargé automatiquement et qui "bug" Celui ci à du être ajouté par un utilisateur, il faudrait le supprimer... Avant de désinstaller, essayes simplement de démarrer ta session avec un nouveau profil. Si ça fonctionne, c'est qu'il y a eu une personnalisation mal effectuée et mise en démarrage dans l'autre profil. NB:COPY_OD n'est pas chargé automatiquement normalement (est-ce le fichier original?)
-
[Résolu] Selection d'une polyligne fermée.
bonuscad a répondu à un(e) sujet de stugeol dans LISP et Visual LISP
Hum, vaudrait mieux ne pas se limiter à une égalité mais à une opération boléenne sur le bit... Si tu as le mode "typeligne gen" sur ta polyligne (70 . 128), si celle ci est fermée (70 . 129), ton égalité va écarter cette polyligne qui correspond pourtant au critère. -
[Résolu] Selection d'une polyligne fermée.
bonuscad a répondu à un(e) sujet de stugeol dans LISP et Visual LISP
Bonjour, Tu peux aussi faire une sélection filtrée sur le bit 70 des polylignes, cela te dispense de faire des tests de validité dans ton code. Exemple de sélection sur des polylignes anciennes (poly3D inclu) et nouvelles, excluant celle qui sont ouvertes et les polymailles (while (not (setq js (ssget "_+.:E:S" (list (cons 0 "*POLYLINE") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) (cons -4 "<AND") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") (cons -4 "&") (cons 70 1) (cons -4 "AND>") ) ) ) ) (princ "\nPas d'objets valable ou sélection vide!") ) -
Bonjour, Quel sont les valeurs actuelles des variables RASTERPREVIEW et UPDATETHUMBNAIL dans AutoCAD ?
-
Lorsque ta sélection est effectuée, pour tester; tu copie-colle le code en ligne de commande et cela sera exécuté immédiatement.
-
Bonjour, (entmake) permet de créer des entités sur des calques non définis au préalable, même pas besoin de s'assurer que le calque existe dans la table des "LAYER", (entmake) assume la cohérence avec la définition de la table. Donc le code suivant devrait fonctionner avec soit une sélection effectuée ou objet "gripés". Attention je ne vérifie pas les caractères autorisés pour le nom du calque (absence de :? < > etc..) ((lambda ( / js nam_lay n dxf_ent dxf_nent) (setq js (ssget "_I")) (if (null js) (setq js (ssget "_P"))) (cond (js (setq nam_lay (getstring T "\nNom du nouveau calque?: ")) (repeat (setq n (sslength js)) (setq dxf_ent (entget (ssname js (setq n (1- n)))) dxf_ent (subst (cons 8 nam_lay) (assoc 8 dxf_ent) dxf_ent) ) (entmake dxf_ent) (if (member (cdr (assoc 0 dxf_ent)) '("INSERT" "POLYLINE")) (progn (setq dxf_nent (entget (entnext (cdar dxf_ent)))) (while (/= (cdr (assoc 0 dxf_nent)) "SEQEND") (setq dxf_nent (subst (cons 8 nam_lay) (assoc 8 dxf_nent) dxf_nent)) (entmake dxf_nent) (setq dxf_nent (entget (entnext (cdar dxf_nent)))) ) (entmake dxf_nent) ) ) ) ) ) (prin1) ))
-
Je me rappelle du mode rapide qui était le bit 1024 d'OSMODE Maintenant, ils parlent de: Effectivement si cette valeur précise est affectée, cela désactive, mais si c'est la somme, ce n'est plus le cas. Exemple (+ 1 32 1024) soit 1057, le mode extrémité et intersection ne sont pas désactivés. Donc essayes de rajouter ce bit à ton mode souhaité, voir si cela change le comportement.
-
Cela oblige l'affichage du message en ligne de commande sur une nouvelle ligne. Sans cela si tu valide ton entrée utilisateur par la barre espace' date=' la prochaine invite va s'afficher à la suite. (C'est du "paufinage" ;) ) Tu trouvera les caractères spéciaux dans l'aide autolisp concernant la fonction (prin1). C'est simplement le mode forcé d'accrochage à "aucun" ("_none" en international) Une sortie silencieuse du programme, autrement tu as le retour de la dernière évaluation (qui est souvent "nil") qui s'affiche. On peut mettre indifféremment (prin1) A part le "_none" qui a vraiment son importance (si tu ne gère pas la variable OSMODE dans ton code), le reste n'est qu'une histoire de présentation afin de simuler proprement un comportement de ta nouvelle commande comme celle d'autocad.
-
Bonjour, En partant de ton 1er code, voici les suggestions et remarques: En lisp les point sont représenter sous forme de liste dont le X est le 1er élément, le Y le 2ème et éventuellement le Z en 3ème. Pour obtenir le X il faut prendre le (car) de la liste, pour le Y ce sera le (cadr) et pour le Z (caddr) Lors de l'usage de (getxxx) il faut armer le bit (initget) juste avant chaque appel. ATTENTION aux accroches objet avec l'appel (command) Un corrigé pour mieux comprendre (defun c:corn ( / P1 P2 P3 P4 P5 P6 LA HT EP) (initget (+ 1 8)) (setq P1 (getpoint "\nSelectionner le point de base : ")) (initget (+ 1 2 4)) (setq LA (getdist P1 "\nLargeur de la cornière : ")) ;(getreal "Largeur de la cornière : ") (initget (+ 1 2 4)) (setq HT (getdist P1 "\nHauteur de la cornière : ")) ;(getreal "Hauteur de la cornière : ") (initget (+ 1 2 4)) (setq EP (getdist P1 "\nEpaisseur de la cornière : ")) ;(getreal "Epaisseur de la cornière : ") (setq P2 (list (+ (car P1) LA) (cadr P1))) ;(+ P1 (+ LA) (+ 0) (+ 0)) (setq P3 (list (car P2) (+ (cadr P2) EP))) ;(+ P2 (+ 0) (+ EP) (+ 0)) (setq P4 (list (- (car P3) (- LA EP)) (cadr P3))) ;(+ P3 (- LA EP) (+0) (+ 0)) (setq P5 (list (car P4) (+ (cadr P4) (- HT EP)))) ;(+ P4 (+ 0) (+ (- HT EP) (+0))) (setq P6 (list (- (car P5) EP) (cadr P5))) ;(+ P5 (- EP) (+ 0) (+ 0)) (command "_.pline" "_none" P1 "_none" P2 "_none" P3 "_none" P4 "_none" P5 "_none" P6 "_close") (princ) ) La manipulation des listes est la base du Lisp ;)
-
Fonction d'affichage de données d'objets en temps reel
bonuscad a répondu à un(e) sujet de fabcad dans Pour aller plus loin en LISP
Bonjour, Essayes cette version corrigée, j'ai rajouter une condition de test et surtout remis la variable fieldnames à nil dans la boucle (grread). C'est elle qui provoquait cette erreur. Surprenant qu'elle fonctionnait sans "bugs" sur des versions antérieures... readobjectdata.lsp -
Sélectionner des textes par rapport à une polyligne de 2 points
bonuscad a répondu à un(e) sujet de fabcad dans Pour aller plus loin en LISP
Pour moi la pièce jointe se télécharge. Ton code n'est pas assez générique pour qu'on puisse tester quoique ce soit (lié à ta structure d'OD et de calque propre à ton dessin), donc sans un extrait de DWG... Mais comme dis gegematic, "_fence" ne devrait pas poser de problème. Pour en être sûr, tu peux mettre "_QTEXT" en "_on" et si tes polylignes traversent bien tous les cadres de textes, ça devrait fonctionner. -
Bonjour, Juste en voyant tes images, j'ai simplement l'impression que tes "aplats" (hachures solides) ont simplement passé en premier plan. Tu devrais passer, soit tes types de lignes en avant (ou au dessus de l'objet), soit passer tes hachures à l'arrière (ou au dessous de l'objet). L'axe de définition du type de ligne a servi à autocad pour la délimitation de tes hachures, ce qui explique qu'elle sont venue "bouffer" sur ton type de ligne. Si les hachure concommitantes avaient été aussi au dessus tu n'aurais partiquement plus rien vu. Donc commande _DRAWORDER ... J'avais pas vu que ton problème avait été résolu, le 32 qui apparait m'a enduis en erreur, me faisant penser à un ordre d'affichage. Mais la réponse de Kallain est exacte aussi.
-
Comme je ne ferais plus le poids contre l’exécution en NET, je ne propose pas la continuité de mon code en lisp. J'ai testé la version d'Olivier sans problèmes, sauf sur des OD de type point: Aucun retour de la commande MQSELECT malgré une requête correcte. Voilà pour le "feedback"
-
Remplacer multiligne par une autre multiligne
bonuscad a répondu à un(e) sujet de fauxsuisse dans AutoCAD 2012
Bonjour, Ce que je peux proposer avec une version pleine est de retracer une Multiligne avec le style courant, une façon de changer sont style de ligne!... Voici (écrit rapidement) le code: (vl-load-com) (defun l-coor2l-pt (lst flag / ) (if lst (cons (list (car lst) (cadr lst) (if flag (+ (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) (caddr lst)) (if (vlax-property-available-p ename 'Elevation) (vlax-get ename 'Elevation) 0.0) ) ) (l-coor2l-pt (if flag (cdddr lst) (cddr lst)) flag) ) ) ) (defun c:change_mline ( / js ent ename l_pt cur_lay closed) (princ "\nSélectionner une multiligne.") (while (null (setq js (ssget "_+.:E:S" '((0 . "MLINE"))))) (princ "\nCe n'est pas une multiligne!") ) (setq ent (ssname js 0) ename (vlax-ename->vla-object ent) l_pt (l-coor2l-pt (vlax-get ename 'Coordinates) T) cur_lay (getvar "CLAYER") ) (initget "Fermée Ouverte _Closed Open") (if (eq (getkword "\nMultiligne [Fermée/Ouverte] <Ouverte>: ") "Closed") (setq closed T) ) (setvar "clayer" (vlax-get ename 'Layer)) (command "_.mline") (foreach n l_pt (command "_none" (trans n 0 1))) (if closed (command "_close") (command "")) (entdel ent) (setvar "CLAYER" cur_lay) (prin1) ) -
Sans avoir essayé quoi que ce soit... Si tu laisse MIRRTEXT à 1, tu fais tes miroirs et ensuite tous tes blocs ainsi inversés tu leurs change leurs vecteurs de direction. Du vecteur normal (0,0,1) tu leurs appliques (0,0,-1) (code DXF 210)
-
Bonjour Patrice, Bon, j'ai pas mal galéré avec la gestion des listes en DCL, je pense que mon code est encore un peu brouillon mais il à l'air de fonctionner. J'ai éditer mon code précédent (bug vu par tes soins) et t'invite donc à tester de nouveau cette nouvelle mouture. Pour les autres demandes, j'attends d'abord de voir que le code actuel fasse ses preuves. Si dans mon esprit les opérateurs semblent pouvoir être intégrés, ce n'est pas le cas (en tout cas d'une manière simple) pour l'utilisation des jokers. (il faut avoir à l'esprit que les données d'objet peuvent être des chaînes, entiers ou réels, donc difficile d'employer des jokers pour des substitutions) Bon tests
-
Salut, Un DWG exemple ne serait pas de refus pour corriger le bug car je n'ai que peu (pour l'instant) de fichiers ayant des OD. J'ai le sentiment d'avoir mis le doigt dans un engrenage, donc pour les améliorations cela peut être demain comme 2 ans (comme mon lancement du sujet en 2010), mais tes suggestions sont intéressantes et m'y pencherai peut être dessus... L'ennui est qu'il y a peu de lispeur sous map, en tout cas je trouve très peu de code source sur le Net, donc j'avance très doucement. On avancerai tellement plus vite à plusieurs...
-
Bonjour, Je reviens sur ce sujet car à ce jour j'avais besoin d'un outil. N'étant jamais mieux servi que par soi-même, je me suis pencher sur un code de filtrage sur OD. Je le livre en version bêta si cela intéresse d'autre personnes pour effectuer des tests (defun c:Sel_By_OD ( / js dxf_model all_fldnamelist all_fldtypelist all_vallist tbllist tbldef tblstr fldnamelist fldtypelist fldnme fldtyp numrec ct cttemp vallist typ val tmp_file dcl_file dcl_id indx Id_tbl Id_nam Id_val what_next js_sel n) (princ "\nSelection d'un objet modèle: ") (while (null (setq js (ssget "_+.:E:S:L:N" (list (cons 0 "*") (cons 67 (if (eq (getvar "CVPORT") 2) 0 1)) (cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB"))) ) ) ) ) ) (setq dxf_model (entget (ssname js 0)) all_fldnamelist () all_fldtypelist () all_vallist ()) (if (null (setq tbllist (ade_odgettables (cdar dxf_model)))) (princ "\nL'objet séléctionné ne contient pas de données d'objet.") (foreach tbl (reverse tbllist) (setq tbldef (ade_odtabledefn tbl) tblstr (cdr (nth 2 tbldef)) fldnamelist () fldtypelist () ) (foreach fld tblstr (setq fldnme (cdr (nth 0 fld)) fldtyp (cdr (nth 2 fld)) fldnamelist (append fldnamelist (list fldnme)) fldtypelist (append fldtypelist (list fldtyp)) ) ) (setq numrec (ade_odrecordqty (cdar dxf_model) tbl) ct 0 all_fldnamelist (cons fldnamelist all_fldnamelist) all_fldtypelist (cons fldtypelist all_fldtypelist) ) (while (< ct numrec) (setq cttemp 0 vallist ()) (foreach fld fldnamelist (setq typ (nth cttemp fldtypelist) cttemp (+ cttemp 1) val (ade_odgetfield (cdar dxf_model) tbl fld ct) ) (if (= typ "Integer")(setq val (fix val))) (setq vallist (append vallist (list val))) ) (setq ct (+ ct 1)) ) (setq all_vallist (cons vallist all_vallist)) ) ) (cond ((and tbllist all_fldnamelist all_fldtypelist all_vallist) (setq tmp_file (vl-filename-mktemp "sel_by_od.dcl") dcl_file (open tmp_file "w") ) (write-line "Sel_By_OD : dialog { label = \"Choix des champs à filtrer\"; :column { label = \"Application\"; :popup_list {key=\"tbl\";edit_width=25;} } :column { label = \"Données d'objets\"; :popup_list {key=\"nam\";edit_width=25;} :edit_box { label = \"Valeur du champ:\"; mnemonic = \"V\"; key = \"val\"; edit_width = 15; edit_limit = 31; } } ok_cancel_err; }" dcl_file ) (close dcl_file) (setq dcl_id (load_dialog tmp_file) indx (1- (length tbllist)) Id_tbl (nth indx tbllist) Id_nam (car (nth indx all_fldnamelist)) Id_val (car (nth indx all_vallist))) (setq what_next 2) (while (< 1 what_next) (if (not (new_dialog "Sel_By_OD" dcl_id)) (exit)) (start_list "tbl") (mapcar 'add_list tbllist) (end_list) (set_tile "tbl" (itoa indx)) (start_list "nam") (mapcar 'add_list (nth indx all_fldnamelist)) (end_list) (set_tile "nam" (itoa (- (length (nth indx all_fldnamelist)) (length (member (car (nth indx all_fldnamelist)) (nth indx all_fldnamelist)))))) (set_tile "val" (setq Id_val (car (mapcar '(lambda (x) (cond ((eq (type x) 'REAL) (rtos x)) ((eq (type x) 'INT) (itoa x)) (T x) ) ) (nth indx all_vallist) ) ) ) ) (set_tile "error" "") (action_tile "tbl" "(setq Id_tbl (nth (setq indx (fix (atof (get_tile \"tbl\")))) tbllist)) (start_list \"nam\") (mapcar 'add_list (nth indx all_fldnamelist)) (end_list) (set_tile \"nam\" (setq Id_nam (nth (- (length (nth indx all_fldnamelist)) (length (member (car (nth indx all_fldnamelist)) (nth indx all_fldnamelist)))) (nth indx all_fldnamelist)))) (set_tile \"val\" (setq Id_val (car (mapcar '(lambda (x) (cond ((eq (type x) 'REAL) (rtos x)) ((eq (type x) 'INT) (itoa x)) (T x) ) ) (nth indx all_vallist) ) ) ) ) ") (action_tile "nam" "(setq Id_nam (nth (fix (atof (get_tile \"nam\"))) (nth indx all_fldnamelist))) (set_tile \"val\" (setq Id_val (nth (vl-position Id_nam (nth indx all_fldnamelist)) (mapcar '(lambda (x) (cond ((eq (type x) 'REAL) (rtos x)) ((eq (type x) 'INT) (itoa x)) (T x) ) ) (nth indx all_vallist) ) ) ) ) ") (action_tile "val" "(setq Id_val $value)") (action_tile "accept" "(done_dialog 1)") (action_tile "cancel" "(done_dialog 0)") (setq what_next (start_dialog)) ) (unload_dialog dcl_id) (vl-file-delete tmp_file) (setq typ (nth (- (length (nth indx all_fldnamelist)) (length (member id_nam (nth indx all_fldnamelist)))) (nth indx all_fldtypelist))) (cond ((eq typ "Real") (setq Id_val (atof Id_val))) ((eq typ "Integer") (setq Id_val (atoi Id_val))) ) (setq js (ssget "_X" (list (assoc 0 dxf_model) (assoc 8 dxf_model) (if (assoc 6 dxf_model) (assoc 6 dxf_model) '(6 . "BYLAYER")) (if (assoc 62 dxf_model) (assoc 62 dxf_model) '(62 . 256)) (if (assoc 48 dxf_model) (assoc 48 dxf_model) '(48 . 1)) (cons 67 (if (eq (getvar "CVPORT") 1) 1 0)) (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model")) ) ) js_sel (ssadd) ) (cond (js (repeat (setq n (sslength js)) (if (not (null (setq tbllist (ade_odgettables (setq ent (ssname js (setq n (1- n)))))))) (foreach tbl tbllist (setq tbldef (ade_odtabledefn tbl) tblstr (cdr (nth 2 tbldef)) fldnamelist () fldtypelist () ) (foreach fld tblstr (setq fldnme (cdr (nth 0 fld)) fldtyp (cdr (nth 2 fld)) fldnamelist (append fldnamelist (list fldnme)) fldtypelist (append fldtypelist (list fldtyp)) ) ) (setq numrec (ade_odrecordqty ent tbl) ct 0) (while (< ct numrec) (setq cttemp 0) (foreach fld fldnamelist (setq typ (nth cttemp fldtypelist) cttemp (+ cttemp 1) val (ade_odgetfield ent tbl fld ct) ) (if (= typ "Integer")(setq val (fix val))) (if (and (eq tbl Id_tbl) (eq fld Id_nam) (equal val Id_val 0.00000001)) (setq js_sel (ssadd ent js_sel)) ) ) (setq ct (+ ct 1)) ) ) ) ) ) ) ) ) (princ (strcat "\n" (itoa (sslength js_sel)) " trouvé(s)")) (sssetfirst nil js_sel) (prin1) )
-
Je pense aussi la même chose, mais le problème récurent est que les entités sont définies dans un système de coordonnées générale avec une mantisse importante qui "bouffent" la précision des décimales. En effet certains cercles deviennent impossible à ajuster aux tangentes, Autocad ne trouve plus les intersections. La solution (sans applicatifs supplémentaires) est de déplacer temporairement l'axe vers l'origine avant d'appliquer les routines proposées. En faisant cela on retrouve bien les points de tangences, et les ajustements peuvent se faire.
-
Copie-colle directement ce qui suit en ligne de commande pour voir si ça te convient... ((lambda ( / js borne ss suivant n ent dxf_code) (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))) (cond (js (setvar "CMDECHO" 0) (command "_.point" (getvar "VIEWCTR")) (setq borne (entlast)) (command "_.explode" js) (setvar "CMDECHO" 1) (if (and borne (entget borne)) (progn (setq ss (ssadd)) (while (setq Suivant (entnext Borne)) (if (eq (cdr (assoc 0 (entget Suivant))) "ARC") (ssadd Suivant ss) ) (setq Borne Suivant) ) (cond (ss (repeat (setq n (sslength ss)) (setq dxf_code (entget (setq ent (ssname ss (setq n (1- n))))) dxf_code (subst '(0 . "CIRCLE") '(0 . "ARC") dxf_code) ) (foreach n (list '(100 . "AcDbArc") (assoc 50 dxf_code) (assoc 51 dxf_code)) (setq dxf_code (vl-remove n dxf_code)) ) (entdel ent) (entmake dxf_code) ) ) ) ) ) (entdel borne) ) ) (prin1) ))
-
Je pense que si... Il te suffit d'installer un traceur DXB par le gestionnaire de traçage. De faire une sortie avec ce traceur, cette sortie ce fait toujours dans un fichier. Tu réimporte ce fichier avec la commande _DXBIN et tu as ton texte vectorisé. Si les texte sont issus de true type (police remplie) tu obtiendra une police remplie par des hachures qui donnerra la même illusion de police pleines. En mode zoom rapproché tu te rendra compte d'imperfection, mais à même échelle de zoom le résultat est tout à fait sastifaisant.
-
Cotation avec point de base "mémorisé"
bonuscad a répondu à un(e) sujet de nicolas2 dans AutoCAD 2012
Bonjour, Je me suis essayé à un petit exercice qui répondra peut être à la demande. Le but est d'utiliser les lignes de rappel avec un champ dynamique. L'ordonnée inscrite se fera par rapport à l'ordonnée de l'origine du SCU en cours. Donc il suffit de faire par exemple "SCU" "Origine" pour placer la référence puis d'utiliser le lisp qui suit pour inscrire les cotes par rapport au seuil. Vous vous êtes trompez de seuil! Il suffit de recaler le seuil avec SCU Origine puis mettre à jour les champs des lignes de rappel concernées. (defun c:niv_field ( / AcDoc Space pt_pos obj pt_field htx rtx rtx0) (vl-load-com) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (initget 8) (while (setq pt_pos (getpoint "\nPlacez un point de niveau à coter: ")) (cond ((null (tblsearch "LAYER" "Etiquette niveau")) (vla-add (vla-get-layers AcDoc) "Etiquette niveau") ) ) (vla-addPoint Space (vlax-3d-point (setq pt_pos (trans pt_pos 1 0)))) (setq obj (vlax-ename->vla-object (entlast))) (vlax-put obj 'Layer "Etiquette niveau") (initget 9) (setq pt_field (trans (getpoint (trans pt_pos 0 1) "\nEmplacement du texte?: ") 1 0)) (cond ((and (not htx) (not rtx)) (initget 6) (setq htx (getdist (trans pt_field 0 1) (strcat "\nSpécifiez la hauteur du champ <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (if (not (setq rtx (getorient (trans pt_field 0 1) "\nSpécifiez l'orientation du champ <0.0>: "))) (setq rtx 0.0)) ) ) (setq rtx0 (+ (angle '(0 0 0) (getvar "UCSXDIR")) rtx)) (mapcar '(lambda (lx) (apply '(lambda (ins_point value_field att_point txt_height dwg_dir name_style name_layer txt_rot / nw_obj) (setq nw_obj (vla-addMtext Space (vlax-3d-point ins_point) 0.0 (strcat "{\\fArial|b0|i0|c0|p34;" "%<\\AcExpr (%<\\AcObjProp.16.2 Object(%<\\_ObjId " (itoa (vla-get-ObjectID obj)) value_field "-%<\\AcVar ucsorg \\f \"%lu2%pt2\">%) \\f \"%lu2%ps[+ ,]\">%}" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list att_point txt_height dwg_dir ins_point name_style name_layer txt_rot) ) ) lx ) ) (list (list (mapcar '+ pt_field (list (- (* (getvar "TEXTSIZE") (cos rtx0)) (* (- (* (getvar "TEXTSIZE") 0.5)) (sin rtx0))) (+ (* (getvar "TEXTSIZE") (sin rtx0)) (* (- (* (getvar "TEXTSIZE") 0.5)) (cos rtx0))) 0.0 ) ) ">%).Coordinates \\f \"%lu2%pt2\">%" 1 (getvar "TEXTSIZE") 5 (getvar "TEXTSTYLE") "Etiquette niveau" rtx ) ) ) (vlax-invoke Space 'addLeader (append pt_pos pt_field) (vlax-ename->vla-object (entlast)) acLineWithArrow ) (vlax-put (vlax-ename->vla-object (entlast)) 'Layer "Etiquette niveau") (vlax-put (vlax-ename->vla-object (entlast)) 'ArrowheadSize (getvar "TEXTSIZE")) (initget 8) ) (prin1) ) NB:Si vous voulez figer les textes (qu'ils ne soient plus dépendant de l'origine du SCU lors de prochaine session), il suffit d'exploser les textes de rappel pour qu'ils gardent définitivement leur valeur)
