bonuscad

En reprenant le code de @Luna sous cette forme, cela va mieux? (defun c:RBx ( / r jsel i name entl rot) (defun update_block (block_record ang pt / s_e dxf_e) (if (/= (getvar "ATTMODE") 1) (setvar "ATTMODE" 1)) (setq s_e block_record) (while (/= (cdr (assoc 0 (entget (setq s_e (entnext s_e))))) "SEQEND") (setq dxf_e (entget s_e)) (if (eq (cdr (assoc 0 dxf_e)) "ATTRIB") (progn (entmod (setq dxf_e (subst (cons 10 (polar pt (+ (angle pt (cdr (assoc 10 dxf_e))) (- ang (cdr (assoc 50 dxf_e)))) (distance pt (cdr (assoc 10 dxf_e))))) (assoc 10 dxf_e) dxf_e))) (entmod (setq dxf_e (subst (cons 50 ang) (assoc 50 dxf_e) dxf_e))) ) ) ) (entupd block_record) ) (if (null (setq r (getorient (strcat "\nValeur ajoutée pour la rotation <" (angtos (+ pi (getvar "ANGBASE")))"> : ")))) (setq r pi) ) (and (setq jsel (ssget '((0 . "INSERT")))) (repeat (setq i (sslength jsel)) (setq name (ssname jsel (setq i (1- i))) entl (entget name) rot (cdr (assoc 50 entl)) ) (entupd (cdar (entmod (subst (cons 50 (+ rot r)) (assoc 50 entl) entl)))) (update_block name (+ rot r) (cdr (assoc 10 entl))) ) ) (princ) )

Bonjour, Suite à ce sujet lancer dans le forum AutoDesk, j'ai trouvé la problématique intéressante. Donc je me suis attelé à essayé de résoudre cette demande. Voici à quoi je suis arrivé, le code n'est certainement pas parfait, mais bien abouti. (J'y ai passé pas mal de temps, et pour une fois je ne livrerais pas le code source) Explication succincte du programme: Pour une rapidité d’exécution il est demander de ne sélectionner que les polylignes susceptibles d'être concernées par la recherche iso-distance Puis le point de base/référence de la mesure. Ce point de base peut être n'importe où, sil n'est pas à l'origine ou à la fin de la polylyligne, celle ci sera coupée (mais en préservant les données d'objet de Map et/ou les Xdata) Il vous sera demandé aussi un fuzz pour l'égalité: réseau dans de grande coordonnées ou standard. Si une polyligne secondaire n'est pas rattaché à un sommet de la polyligne primaire, un sommet sera inséré à ce nœud. La recherche en arbre est faite à tout les niveaux. Au final des points sont créés à l'iso-distance du point de base. iso_distance.fas

Utiliser le logiciel open source QGIS (peut être avec GRASS installé) Si tu arrive à faire ton MNT, tu doi avoir des tutos sur le net, QGIS exporte au format DXF, format que comprend Autocad.

Alors la spirale d'or à ma façon (moins gracieux que Gilles et Bruno), mais j'ai essayé d'éviter la trigonométrie, juste de l'arithmétique. (defun c:test ( / phi l_r cnt opx opy l) (setq phi (* (1+ (sqrt 5)) 0.5) l_r '(1.0) cnt 0 ) (initget 7) (repeat (getint "\nNombre de répétion?: ") (setq l_r (cons (expt phi (setq cnt (1+ cnt))) l_r)) ) (setq l_r (reverse l_r) cnt 0 l '((1.0 0.0))) (while l_r (cond ((zerop cnt) (setq opx - opy +)) ((zerop (rem cnt 4)) (setq opx - opy + cnt 0)) ((zerop (rem cnt 3)) (setq opx + opy +)) ((zerop (rem cnt 2)) (setq opx + opy -)) ((zerop (rem cnt 1)) (setq opx - opy -)) ) (setq l (cons (list ((eval opx) (caar l) (car l_r)) ((eval opy) (cadar l) (car l_r))) l) l_r (cdr l_r) cnt (1+ cnt) ) ) (entmakex (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length l)) (cons 70 0) ) (apply 'append (mapcar (function (lambda (x) (list (cons 10 x) (cons 42 (1- (sqrt 2))) ) ) ) (reverse l) ) ) ) ) )

Salut, Il me semble que t'avais déjà eu une réponse à ce sujet: voir ta question. Autrement cet exemple extrait de AutoCAD 2011 Help

Un truc qui pourrais être envisagé, mais que je n'ai pas essayé... Substituer tout tes blocs par des images (de préférence en tiff 2 tons (N/B) pour avoir une transparence de l'image ne laissant voir que le filaire et ne pas avoir un masque d'image). Le gros travail, sera de constituer ces images à partir de ces blocs (ça peut éventuellement s'automatiser, mais sans certitude) Une fois ces images obtenues, une petite routine pour substituer les insertions de bloc par les images, puis en purgeant les blocs avant livraison. A la réception d'un fichier retravaillé tu fais la procédure inverse de substitution pour retrouvé ton travail original. Les images donneront le résultat final de ton travail sans pouvoir le modifier au niveau des blocs. L'inconvénient les images peuvent rendre un dessin assez lourd suivant le nombre. On pourrait aussi envisager aussi des shapes (formes) qui serait beaucoup plus léger mais plus difficile à créer, même parfois impossible si les blocs sont complexes. En tout cas pas vraiment de solutions simples...

Voir que 16 ans après ça sert encore !... Heureux de l'apprendre. 😊

C'est faisable, mais dans ce cas je me limite à la bibliothèque de bloc interne au dessin et ne propose que les blocs sans attributs. ;; ListBox (gile) ;; Boite de dialogue permettant un ou plusieurs choix dans une liste ;; ;; Arguments ;; title : le titre de la boite de dialogue (chaîne) ;; msg ; message (chaîne), "" ou nil pour aucun ;; keylab : une liste d'association du type ((key1 . label1) (key2 . label2) ...) ;; flag : 0 = liste déroulante ;; 1 = liste choix unique ;; 2 = liste choix multipes ;; ;; Retour : la clé de l'option (flag = 0 ou 1) ou la liste des clés des options (flag = 2) ;; ;; Exemple d'utilisation ;; (listbox "Présentation" "Choisir une présentation" (mapcar 'cons (layoutlist) (layoutlist)) 1) (vl-load-com) (defun str2lst (str sep / pos) (if (setq pos (vl-string-search sep str)) (cons (substr str 1 pos) (str2lst (substr str (+ (strlen sep) pos 1)) sep) ) (list str) ) ) (defun ListBox (title msg keylab flag / tmp file dcl_id choice) (setq tmp (vl-filename-mktemp "tmp.dcl") file (open tmp "w") ) (write-line (strcat "ListBox:dialog{label=\"" title "\";") file ) (if (and msg (/= msg "")) (write-line (strcat ":text{label=\"" msg "\";}") file) ) (write-line (cond ((= 0 flag) "spacer;:popup_list{key=\"lst\";") ((= 1 flag) "spacer;:list_box{key=\"lst\";width=32;") (T "spacer;:list_box{key=\"lst\";width=32;multiple_select=true;") ) file ) (write-line "}ok_cancel_err;}" file) (close file) (setq dcl_id (load_dialog tmp)) (if (not (new_dialog "ListBox" dcl_id)) (exit) ) (start_list "lst") (mapcar 'add_list (mapcar 'cdr keylab)) (end_list) (action_tile "accept" "(or (= (get_tile \"lst\") \"\") (if (= 2 flag) (progn (foreach n (str2lst (get_tile \"lst\") \" \") (setq choice (cons (nth (atoi n) (mapcar 'car keylab)) choice)) ) (setq choice (reverse choice)) ) (setq choice (nth (atoi (get_tile \"lst\")) (mapcar 'car keylab))) ) ) (done_dialog)" ) (start_dialog) (unload_dialog dcl_id) (vl-file-delete tmp) choice ) (defun c:Max73 ( / js ent dxf_210 vla_obj flag tbl_blk lst_blk sel_blk blk tmp nw_pt param deriv alpha ) (vl-load-com) (princ "\nSélectionner un objet curviligne sur lequel vous voulez effectuer une animation.") (while (not (setq js (ssget "_+.:E:S" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") (cons -4 "AND>") (cons 0 "SPLINE") (cons -4 "OR>") ) ) ) ) ) (setq ent (ssname js 0) dxf_210 (cdr (assoc 210 (entget ent))) vla_obj (vlax-ename->vla-object ent) flag T ) (while (setq tbl_blk (tblnext "BLOCK" flag)) (if (zerop (cdr (assoc 70 tbl_blk))) (setq lst_blk (cons (cdr (assoc 2 tbl_blk)) lst_blk)) ) (setq flag nil) ) (cond (lst_blk (setq lst_blk (vl-sort lst_blk '<)) (while (setq sel_blk (listbox "Bibliothèque interne de blocs" "Choisir un bloc" (mapcar 'cons lst_blk lst_blk) 1)) (setq blk (vlax-ename->vla-object (entmakex (list (cons 0 "INSERT") (cons 100 "AcDbEntity") (cons 8 (getvar "CLAYER")) (cons 100 "AcDbBlockReference") (cons 2 sel_blk) (cons 10 (trans '(0.0 0.0 0.0) 0 dxf_210)) (cons 50 (angle (trans '(0.0 0.0 0.0) 0 dxf_210) (trans '(0.0 1.0 0.0) 0 dxf_210))) (cons 210 dxf_210) ) ) ) ) (princ "\nGuider votre objet") (while (= 5 (car (setq tmp (grread t 5 1)))) (cond ((= 5 (car tmp)) (setq nw_pt (vlax-curve-getClosestPointTo vla_obj (trans (cadr tmp) 1 0)) param (vlax-curve-getparamatpoint vla_obj nw_pt) deriv (vlax-curve-getfirstderiv vla_obj param) alpha (atan (cadr deriv) (car deriv)) ) (vlax-put blk 'InsertionPoint nw_pt) (vlax-put blk 'Rotation alpha) ) (T (princ "\nArrêt anormal de la commande ")) ) ) ) ) (T (princ "\nAucun bloc simple sans attributs défini dans ce dessin")) ) (prin1) )

Si les remarques concerne mon code, en effet je peux inclure la conservation du type de ligne (ainsi que l'échelle du type de ligne, l'épaisseur, et la couleur vraie) Voici en pièce jointe le code my_project.lsp

Bonjour, J'ai modifié le code d’aplatissement essentiellement d'objets curviligne. Celui ci tient maintenant compte aussi d'une éventuelle élévation de l'objet pour le ramener en Z à zéro. Voir le code mis à jour ICI

@JPhil Merci du retour, J'ai mis à jour le post du code pour prendre en considération le survol d'attributs d'un bloc. J'ai testé rapidement, cela semble bon...

Alors voici un petit bout de code écrit pour une autre demande: Il demande de sélectionner un objet filaire, puis un bloc unique qu'il va aligner dynamiquement. On peut facilement rajouter l'introduction du nom du bloc au lieu d'en sélectionner un. A essayer tel quel (defun c:anim_obj ( / js ent vla_obj js_obj tmp nw_pt param deriv alpha ) (vl-load-com) (princ "\nSélectionner un objet curviligne sur lequel vous voulez effectuer une animation.") (while (not (setq js (ssget "_+.:E:S" (list (cons -4 "<OR") (cons -4 "<AND") (cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") (cons -4 "AND>") (cons 0 "SPLINE") (cons -4 "OR>") ) ) ) ) ) (setq ent (ssname js 0) vla_obj (vlax-ename->vla-object ent) ) (redraw ent 3) (princ "\nSélectionner l'objet à animer.") (while (not (setq js_obj (ssget "_+.:E:S" '((0 . "INSERT")))))) (redraw ent 4) (princ "\nGuider votre objet") (while (= 5 (car (setq tmp (grread t 5 1)))) (cond ((= 5 (car tmp)) (setq nw_pt (vlax-curve-getClosestPointTo vla_obj (trans (cadr tmp) 1 0)) param (vlax-curve-getparamatpoint vla_obj nw_pt) deriv (vlax-curve-getfirstderiv vla_obj param) alpha (atan (cadr deriv) (car deriv)) ) (vlax-put (vlax-ename->vla-object (ssname js_obj 0)) 'InsertionPoint nw_pt) (vlax-put (vlax-ename->vla-object (ssname js_obj 0)) 'Rotation alpha) ) (T (princ "\nArrêt anormal de la commande ")) ) ) (prin1) )

@Max73 Bon je pense y être arrivé avec un bloc avec attribut annotatif avec le même comportement que précédemment avec un texte. TUY_DN-block.lsp

@Max73 Bonjour, je pense que c'est possible mais je suppose que tu veux que le bloc soit annotatif comme pour le texte précédemment? Si c'est le cas je pense que ce sera un peut difficile pour moi de gérer ce bloc (de la création aux insertions multiple), déjà qu'avec le texte cela n'avait pas été simple... Mais j'essaierais de regarder si j'y arrive à un moment d'inspiration. Mais si d'autre s'en sentent capable ... je laisse la main volontiers !

Bonjour, Voici comment je corrige ton code actuel, je te laisse consulter (et comprendre) les nuances entre les deux. (defun c:coffrage ( / distance_deplacement p0 p1 index_objet_a_deplacer jeu objet) (command "_.-purge" "_all" "*" "_yes") (command "_.ZOOM" "_extent") (initget 7) (setq distance_deplacement (getreal "\nRenseigner ecartement des objets: ")) (setq p0 '(0.0 0.0)) (setq p1 (list distance_deplacement 0.0)) (setq index_objet_a_deplacer 0) (setq jeu (ssget)) (repeat (sslength jeu) (setq objet (ssname jeu index_objet_a_deplacer)) (command "_.move" objet "" p0 p1) (setq index_objet_a_deplacer (1+ index_objet_a_deplacer)) (setq p1 (list (+ (car p1) distance_deplacement) 0.0)) ) (prin1) )

Avec la commande INSERER tout simplement. Dans la boite de dialogue, tu clique sur "Parcourir" et tu vas chercher ton bloc (dwg) dans un dossier. S'il a exactement le même nom, AutoCAD va te proposer de le redéfinir dans ton dessin pour toutes les instances qui existent.

Pour construire le code je me suis basé sur ton fichier exemple; qui ne possède que l'échelle d'annotation 1:50. Maintenant que ces textes annotatifs sont sur le même calque: "_Texte" , il est très facile de les sélectionner et de leur rajouter toutes les échelles d'annotation que tu veux. Par contre d'avoir travailler sur ce code m'a révélé, un mauvais usage de cette solution que j'avais proposé. En effet si l'on utilise cette fonction qui supprime toutes les échelles et re-crée la liste, même si l'échelle utilisé dans l'annotation a bien été re-créer à l'identique, cela fait planter le code: En fait l'ID de l'échelle d'annotation a changé dans le dictionnaire et Autocad n'arrive plus à faire le lien avec l'ancienne ID. Sacré poëme! 😵

@Max73 J'ai modifié le lisp TUY_DN joint dans le mon message précédent. Il devrait répondre à tes souhaits évoqués: J'ai eu un peu de mal avec les MTEXT annotatifs; c'est la 1ère fois que j’essaye de les manipuler en lisp, donc ... dis moi si ça te semble correct!

@Max73 Alors si tu trouve l'idée intéressante, voici le code un peu plus poussé. Le texte / les textes seront positionnés à ta guise en suivant l'orientation des segments de la polyligne par un simple click-gauche et click-droit pour terminer. Si tu sélectionne une polyligne déjà définie en tant que tuyau, tu pourra lui affecter un autre "Dn" et le/les textes existants seront alors mis à jour. L'avantage de l'utilisation des Xdata et que tu peux faire des sélections ciblées sur le "Dn" (ou autre valeur d'une Xdata en adaptant le code) sur l'ensemble du dessin. Voici un exemple de code pour faire apparaître les poignée sur tous les tuyaux correspondants. Exemple d'usage du code à taper en ligne de commande (sel_dn "Dn350") (defun sel_dn (typ_tuy / js_pl js nb_pl ent_pl) (setq js_pl (ssget "_X" '((0 . "LWPOLYLINE") (67 . 0) (-3 ("RESEAU_TUYAUX"))))) (cond (js_pl (setq js (ssadd)) (repeat (setq nb_pl (sslength js_pl)) (setq ent_pl (ssname js_pl (setq nb_pl (1- nb_pl)))) (if (eq (cdr (assoc 1000 (cdadr (assoc -3 (entget ent_pl (list "RESEAU_TUYAUX")))))) typ_tuy) (setq js (ssadd ent_pl js)) ) ) (sssetfirst nil js) ) ) ) Je met en pièce jointe le code revisité. NOTE IMPORTANTE: Lors de l'utilisation de la commande TUY_DN veiller à que style courant de texte ne soit pas annotatif car dans ce cas mon programme plante, je ne sais pas gérer ce problème (si d'autre membre peuvent apporter la solution?...) TUY_DN.lsp

On pourrait voir les choses avec les XData et/ou ldata. Voici un exemple de code de départ de ce que l'on pourrait faire... Essaye d'abords le lisp dans un nouveau dessin avec des unités identique de ton travail habituel pour te rendre compte. Répond aux questions qui te seront posées et vois le résultat. TUY_DN.lsp

Bonjour, Pour les XData il y a ce fil de discussion Je remet le code qui a légèrement changé car des utilisateurs ont rencontré des dysfonctionnement lors de l'utilisation dans des SCU. (vl-load-com) (defun c:dyn_read_xdata ( / AcDoc Space UCS save_ucs WCS nw_obj ent_text dxf_ent apps lst_apps data ncol strcatlst Input obj_sel ename) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) UCS (vla-get-UserCoordinateSystems AcDoc) save_ucs (vla-add UCS (vlax-3d-point '(0.0 0.0 0.0)) (vlax-3d-point (getvar "UCSXDIR")) (vlax-3d-point (getvar "UCSYDIR")) "CURRENT_UCS" ) ) (vla-put-Origin save_ucs (vlax-3d-point (getvar "UCSORG"))) (setq WCS (vla-add UCS (vlax-3d-Point '(0.0 0.0 0.0)) (vlax-3d-Point '(1.0 0.0 0.0)) (vlax-3d-Point '(0.0 1.0 0.0)) "TEMP_WCS")) (vla-put-activeUCS AcDoc WCS) (setq nw_obj (vla-addMtext Space (vlax-3d-point (trans (getvar "VIEWCTR") 1 0)) 0.0 "" ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'StyleName 'Layer 'Rotation 'BackgroundFill 'Color) (list 1 (/ (getvar "VIEWSIZE") 100.0) 5 (getvar "TEXTSTYLE") (getvar "CLAYER") 0.0 -1 176) ) (setq ent_text (entlast) dxf_ent (entget ent_text) dxf_ent (subst (cons 90 1) (assoc 90 dxf_ent) dxf_ent) dxf_ent (subst (cons 63 254) (assoc 63 dxf_ent) dxf_ent) ) (entmod dxf_ent) (while (and (setq Input (grread T 4 2)) (= (car Input) 5)) (cond ((setq obj_sel (nentselp (cadr Input))) (if (eq (type (car (last obj_sel))) 'ENAME) (if (member (cdr (assoc 0 (entget (car (last obj_sel))))) '("INSERT" "ACAD_TABLE" "DIMENSION")) (if (or (eq (cdr (assoc 0 (entget (car (last obj_sel))))) "ACAD_TABLE") (not (eq (boole 1 (cdr (assoc 70 (tblsearch "BLOCK" (cdr (assoc 2 (entget (car (last obj_sel)))))))) 4) 4)) ) (setq obj_sel (cons (car (last obj_sel)) '((0.0 0.0 0.0)))) ) ) ) (setq dxf_ent (entget (car obj_sel) (list "*")) ) (if (eq (cdr (assoc 0 dxf_ent)) "VERTEX") (progn (while (eq (cdr (assoc 0 dxf_ent)) "VERTEX") (setq dxf_ent (entget (entnext (cdar dxf_ent)))) ) (setq dxf_ent (entget (cdr (assoc -2 dxf_ent)) (list "*"))) ) ) (if (eq (cdr (assoc 0 dxf_ent)) "ATTRIB") (setq dxf_ent (entget (cdr (assoc 330 dxf_ent)) (list "*"))) ) (setq apps (cdr (assoc -3 dxf_ent)) ncol 0 lst_apps nil ) (if apps (foreach el apps (if (not (member (car el) lst_apps)) (setq lst_apps (cons (car el) lst_apps))) ) ) (if lst_apps (foreach xd lst_apps (setq data (assoc xd apps) strcatlst (strcat (if strcatlst strcatlst "") (apply 'strcat (mapcar '(lambda (x) (if (listp x) (strcat "(" (itoa (car x)) " . " (cond ((eq (car x) 1002) (strcat (if (eq (cdr x) "{") "\"(\"" "\")\""))) ((member (car x) '(1000 1003 1004 1005)) (strcat "\"" (cdr x) "\"")) ((member (car x) '(1040 1041 1042)) (rtos (cdr x))) ((member (car x) '(1070 1071)) (itoa (cdr x))) ((member (car x) '(1010 1011 1012 1013 1020 1021 1022 1023 1030 1031 1032 1033)) (strcat "(" (rtos (cadr x)) "," (rtos (caddr x)) "," (rtos (cadddr x)) ")")) ) ")\\P" ) (strcat "{\\C" (itoa (setq ncol (+ 10 ncol))) " " (car data)"}" "\\P") ) ) data ) ) ) ) ) ) (if strcatlst (progn (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'InsertionPoint 'Height 'TextString) (list (mapcar '- (getvar "VIEWCTR") (list (* (getvar "VIEWSIZE") 0.5) (- (* (getvar "VIEWSIZE") 0.5)) 0.0)) (/ (getvar "VIEWSIZE") 100.0) (strcat "{\\fArial;" strcatlst "}" )) ) ) (vlax-put nw_obj 'TextString "") ) (setq strcatlst nil) ) (T (vlax-put nw_obj 'TextString "")) ) ) (vla-Delete nw_obj) (and save_ucs (vla-put-activeUCS AcDoc save_ucs)) (and WCS (vla-delete WCS) (setq WCS nil)) (prin1) )

Bonjour, Il y a pas mal de temps, j'étais tombé sur une rame TGV en 3D sur le net. Super bien fait! Passez en orbite3D avec le style visuel "Réaliste", vous serez bluffé! Il manque des bogies, mais il y en a quand même un , il sera donc facile de le dupliquer pour compléter. Le fichier: TGV.dwg PS: Le lien est en http et non en https, vous aurez peut être une alerte de sécurité, vous pouvez passer outre: le fichier est sûr.

Rien de transcendant, je l'ai ouvert sur une machine de ce type (je joint l'image des caractéristiques), ceci avec AutocadMap 2019 et l'OS installé sur un SSD. Si tu n'as pas les images, autant les détacher ça évitera déjà à Autocad une recherche inutile... (enregistre le fichier avec les images détachées) Autrement je lance automatiquement un petit fichier qui mets mes variables comme je les aime à l'ouverture de n'importe quel dessin. Ce n'est pas une référence mais cela peut avoir peut-être une incidence?. Voici ce qu'il contient (setvar "ANNOAUTOSCALE" -4) (setvar "APBOX" 1) (setvar "APERTURE" 5) (setvar "ATTDIA" 1) (if (zerop (getvar "ATTMODE")) (setvar "ATTMODE" 1)) (setvar "ATTREQ" 1) (setvar "BLIPMODE" 0) (setvar "CMDDIA" 1) (setvar "DEMANDLOAD" 3) (setvar "DIMZIN" 0) (setvar "DRAGMODE" 2) (setvar "EDGEMODE" 0) (setvar "FILEDIA" 1) (setvar "FILETABPREVIEW" 0) (setvar "FILETABTHUMBHOVER" 0) (setvar "GRIPS" 1) (setvar "HIGHLIGHT" 1) (setvar "HPDLGMODE" 0) (setvar "HPQUICKPREVIEW" 0) (setvar "IMAGEFRAME" 2) (setvar "INDEXCTL" 3) (setvar "INSUNITS" 6) (setvar "INSUNITSDEFSOURCE" 6) (setvar "INSUNITSDEFTARGET" 6) (setvar "LAYOUTREGENCTL" 1) (setvar "LEGACYCTRLPICK" 1) (setvar "MBUTTONPAN" 1) (setvar "MEASUREINIT" 1) (setvar "MEASUREMENT" 1) (setvar "MIRRTEXT" 0) (setvar "OSNAPCOORD" 2) (setvar "PALETTEOPAQUE" 1) (setvar "PDMODE" 68) (setvar "PDSIZE" 0.25) (setvar "PICKADD" 1) (setvar "PICKAUTO" 1) (setvar "PICKBOX" 3) (setvar "PICKDRAG" 0) (setvar "PICKFIRST" 1) (setvar "PICKSTYLE" 1) (setvar "PLINETYPE" 2) (setvar "POLARMODE" 0) (setvar "POLARANG" 90) (setvar "PROJMODE" 1) (setvar "QPMODE" 0) (setvar "REGENMODE" 1) (setvar "ROLLOVERTIPS" 0) (setvar "SDI" 0) (setvar "SELECTIONPREVIEW" 2) (setvar "SHORTCUTMENU" 11) (setvar "TEXTEVAL" 0) (setvar "TEXTFILL" 1) (setvar "UCSFOLLOW" 0) (setvar "UCSDETECT" 0) (setvar "VISRETAIN" 1) (setvar "WHIPARC" 0) (setvar "WHIPTHREAD" 3) (setvar "WSCURRENT" "Bonuscad") (setvar "XLOADCTL" 2) (setvar "XREFOVERRIDE" 0)

Salut pour moi, je n(ai pas de problème de zoom ou de pan, c'est fluide. J'ai un laps de temps lors de la 1ère sélection (par grip) d'un type d'entité polyligne, hachure, le bloc tableau (mais cela reste acceptable, surtout que les sélections suivantes sur le même type d'objet sont instantanée) Pas contre tu as des images attachées, que tu n'as pas livrées, donc pour nous impossible de voir si c'est elles qui posent problème car Autocad les considère introuvables. En plus la 1ére image a un chemin réseau qui est assez long et pour ma part j'ai déjà eu des problèmes avec des images sur un réseau avec un chemin très long. Déjà si tes images sont chargées, tu peux essayer de les décharger (PAS DETACHER) et voir si cela va mieux quand elles sont déchargées. Tu les rechargeras pour produire ton résultat final (traçage, PDF)

Bonjour, De manière statique (fixé en dur et non dynamique comme proposée par (gile) ) J'ai ce bout de code essentiellement pour des LWPOLYLINE (avec ou sans arcs) pour "labelliser" la longueur de chaque segments. Les textes seront dans le calque DIMENSIONS et avec le style de texte DIM-VERTEX, donc plus facile à filtrer si nécessité pour effacer et refaire l'opération. (vl-load-com) (defun c:label_dist_vtx ( / l_var js htx AcDoc Space nw_style n obj ename pr dist_start dist_end pt_start pt_end seg_len alpha val_txt dim_txt nw_obj) (setq l_var (mapcar 'getvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS"))) (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") '(4 3 2 2)) (princ "\nSélectionnez les polylignes.") (while (null (setq js (ssget '((0 . "LWPOLYLINE"))))) (princ "\nLa sélection est vide ou ce n'est pas des LWPOLYLINE!") ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: "))) (if htx (setvar "TEXTSIZE" htx)) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (vla-startundomark AcDoc) (cond ((null (tblsearch "LAYER" "DIMENSIONS")) (vlax-put (vla-add (vla-get-layers AcDoc) "DIMENSIONS") 'color 7) ) ) (cond ((null (tblsearch "STYLE" "DIM-VERTEX")) (setq nw_style (vla-add (vla-get-textstyles AcDoc) "DIM-VERTEX")) (mapcar '(lambda (pr val) (vlax-put nw_style pr val) ) (list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag) (list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0) ) ) ) (repeat (setq n (sslength js)) (setq obj (ssname js (setq n (1- n))) ename (vlax-ename->vla-object obj) pr -1 ) (repeat (fix (vlax-curve-getEndParam ename)) (setq dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr))) dist_end (vlax-curve-GetDistAtParam ename (1+ pr)) pt_start (vlax-curve-GetPointAtParam ename pr) pt_end (vlax-curve-GetPointAtParam ename (1+ pr)) seg_len (- dist_end dist_start) alpha (angle (trans pt_start 0 1) (trans pt_end 0 1)) val_txt (rtos seg_len) dim_txt (textbox (list (cons 1 val_txt))) ) (if (and (> alpha (* pi 0.5)) (< alpha (* pi 1.5))) (setq alpha (+ alpha pi))) (if (> (distance (car dim_txt) (cadr dim_txt)) seg_len) (setq val_txt (vl-string-subst "E \\P" "E " val_txt)) ) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar (vlax-curve-GetPointAtParam ename (+ 0.5 pr)) (+ alpha (* pi 0.5)) (getvar "TEXTSIZE")))) 0.0 val_txt ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 8 (getvar "TEXTSIZE") 5 pt "DIM-VERTEX" "DIMENSIONS" alpha) ) ) ) (vla-endundomark AcDoc) (mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") l_var) (prin1) )