bonuscad

Bonjour, Difficile de suivre ton besoin... Avec ton explication et ton code, j'ai l'impression que tu veux faire 2 choses bien distinctes: 1 Trier tes cercle en fonction de leur rayons. 2 Trier ce résultat par ordre de création de l'objet cercle. Si c'est le cas, je me servirais du handle (maintien: code DXF 5) de l'entité pour faire le tri par l'ordre de création Donc par exemple en repartant du code proposé: (defun c:nettoyeur ( / ent dxf_ent p1 js jsc n nw_js i l_dxf l_ent l_handent) (command "_zoom" "_e") (while (null (setq ent (entsel "\nDésigner un cercle type: ")))) (setq dxf_ent (entget (car ent)) l_ent nil) (setq p1 (cdr (assoc 10 (entget (car ent))))) (command "_.move" "_all" "" "_none" (trans p1 0 1) "_none" "*0.0,0.0,0.0") (cond ((eq (cdr (assoc 0 dxf_ent)) "CIRCLE") (setq js (ssget "_x" (list (assoc 410 dxf_ent) (assoc 67 dxf_ent))) jsc (ssget "_x" (list (assoc 0 dxf_ent) (assoc 410 dxf_ent) (assoc 67 dxf_ent) (assoc 40 dxf_ent))) n -1 ) (repeat (sslength jsc) (ssdel (ssname jsc (setq n (1+ n))) js) ) (if (not (tblsearch "LAYER" "UT1")) (entmake '( (0 . "LAYER") (100 . "AcDbSymbolTableRecord") (100 . "AcDbLayerTableRecord") (2 . "UT1") (70 . 0) (62 . 7) (6 . "Continuous") (290 . 1) (370 . -3) ) ) ) (if js (repeat (setq n (sslength js)) (entdel (ssname js (setq n (1- n)))) ) ) (if jsc (repeat (setq n (sslength jsc)) (entmod (subst '(8 . "UT1") (assoc 8 (setq dxf_ent (entget (ssname jsc (setq n (1- n)))))) dxf_ent)) (setq l_ent (cons (cons (cdr (assoc 5 dxf_ent)) (cdr (assoc -1 dxf_ent))) l_ent)) ) ) ) ) (cond (l_ent (setq l_handent (vl-sort (mapcar 'car l_ent) '<)) (setq nw_js (ssadd) i 0) (foreach el l_handent (ssadd (ssmemb (cdr (assoc el l_ent)) jsc) nw_js) ) ) ) (setq n -1 i 0) (cond (nw_js (repeat (sslength nw_js) (setq l_dxf (entget (ssname nw_js (setq n (1+ n))))) (entmake (list '(0 . "TEXT") '(8 . "UT1") '(10 0.0 0.0 0.0) (cons 11 (cdr (assoc 10 l_dxf))) (cons 40 (* (cdr (assoc 40 l_dxf)) 0.5)) (cons 1 (itoa (setq i (1+ i)))) '(50 . 0) '(71 . 0) '(72 . 1) '(73 . 2) ) ) ) ) ) (command "_zoom" "_e") (prin1) )

Bonjour, Ceci pourrait-il aller? NB: Pour une fenêtre polygonale, c'est la bounding box de celle-ci qui est mise en place. (defun c:ViewPort2Model ( / js ent dxf_ent pt_v l h lst_pt) (princ "\nSélectionner une fenêtre: ") (while (null (setq js (ssget "_+.:E:S:L" (list '(0 . "VIEWPORT") '(67 . 1) (cons 410 (getvar "CTAB")) '(-4 . "!=") '(69 . 1) ) ) ) ) ) (setq pt_v (cdr (assoc 10 (setq dxf_ent (entget (setq ent (ssname js 0)))))) l (cdr (assoc 40 dxf_ent)) h (cdr (assoc 41 dxf_ent)) lst_pt (list (list (- (car pt_v) (* 0.5 l)) (- (cadr pt_v) (* 0.5 h)) 0.0) (list (+ (car pt_v) (* 0.5 l)) (- (cadr pt_v) (* 0.5 h)) 0.0) (list (+ (car pt_v) (* 0.5 l)) (+ (cadr pt_v) (* 0.5 h)) 0.0) (list (- (car pt_v) (* 0.5 l)) (+ (cadr pt_v) (* 0.5 h)) 0.0) ) ) (entmakex (vl-list* (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 67 1) (cons 100 "AcDbPolyline") (cons 90 (length lst_pt)) (cons 70 1) (mapcar '(lambda (p) (cons 10 p)) lst_pt) ) ) (command "_.CHSPACE" (entlast) "") (prin1) )

Salut, Hé bin 3 ans après, je répond à ta question (il aurait fallu la relancer avant) :P Essayes la routine modifiée, testée que brièvement. (defun round_number (xr n / ) (* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n)) ) (defun c:regular_draw ( / js n_count ent dxf_ent dxf_lst) (setq js (ssget '((0 . "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE"))) n_count -1) (cond (js (setvar "cmdecho" 0) (command "_.undo" "_group") (while (setq ent (ssname js (setq n_count (1+ n_count)))) (setq dxf_ent (entget ent)) (cond ((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE") (setq dxf_lst (cdr dxf_ent) dxf_ent (list (car dxf_ent))) (while (cdr dxf_lst) (if (eq 10 (caar dxf_lst)) (setq dxf_ent (cons (cons 10 (trans (mapcar '(lambda (x p) (round_number x (/ 1 p))) (trans (cdar dxf_lst) 0 1) (getvar "SNAPUNIT")) 1 0)) dxf_ent)) (setq dxf_ent (cons (car dxf_lst) dxf_ent)) ) (setq dxf_lst (cdr dxf_lst)) ) (setq dxf_ent (reverse dxf_ent)) ) ((eq (cdr (assoc 0 dxf_ent)) "POLYLINE") (while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar dxf_ent)))))) "VERTEX") (setq dxf_ent (subst (cons 10 (trans (mapcar '(lambda (x p) (round_number x (/ 1 p))) (trans (cdr (assoc 10 dxf_ent)) 0 1) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT"))))) 1 0)) (assoc 10 dxf_ent) dxf_ent)) (entmod dxf_ent) ) ) (T (foreach n dxf_ent (if (member (car n) '(10 11 12 13 40)) (if (listp (cdr n)) (setq dxf_ent (subst (cons (car n) (trans (mapcar '(lambda (x p) (round_number x (/ 1 p))) (trans (cdr n) 0 1) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT"))))) 1 0)) (assoc (car n) dxf_ent) dxf_ent)) (setq dxf_ent (subst (cons (car n) (trans (round_number (trans (cdr n) 0 1) (/ 1 (car (getvar "SNAPUNIT")))) 1 0)) (assoc (car n) dxf_ent) dxf_ent)) ) ) ) ) ) (entmod dxf_ent) (entupd ent) ) (command "_.undo" "_end") (setvar "cmdecho" 1) (princ (strcat "\n" (itoa n_count) " objet(s) transformé(s).")) ) (T (princ "\nAucun objet valide trouvé.")) ) (prin1) )

Bonjour, Tes liste sont mal construite: (setq rect1 (list (x1 (+ y1 (/ dn 2.)))) rect2 (list (x2b (- y1 (/ dn 2.)))) ) devrait être: (setq rect1 (list x1 (+ y1 (/ dn 2.))) rect2 (list x2b (- y1 (/ dn 2.))) ) ainsi que (setq align1 (list (x1 y1)) align2 (list (x2b y1)) align3 (list (x2 y2)) ) qui devrait être: (setq align1 (list x1 y1) align2 (list x2b y1) align3 (list x2 y2) ) Ton jeu de sélection est aussi mal construit: ;;; Creation du jeu de sélection du rectangle (ssadd (entlast (rect))) est plutôt: (setq rect (ssadd (entlast))) et plus loin (ssadd (entlast (rect))) devrait être: (setq rect (ssadd (entlast) rect)) Autre remarque, EVITE les validations dans commande avec un espace entre guillemets par exemple (command-s "-hachures" "Propriétés" "JIS_LC_8A" "40" "15" ;; type ; échelle ; angle "Sélectionner les objets" rect " ") sera mieux comme ceci: (command-s "_.-hatch" "_Properties" "JIS_LC_8A" "40" "15" ;; type ; échelle ; angle "_Select" rect "" "") Et enfin et je ne sais pas pourquoi!, mais chez moi: (command-s "aligner" rect " " "_none" align1 "_none" align1 "_none" align2 "_none" align3 " " "non") me fait des violations et plante autocad celle-ci passe bien (command "_.align" rect "" "_none" align1 "_none" align1 "_none" align2 "_none" align3 "" "_no")

Comme ta demande précédente, en repartant du code de Patrick_35, voici une variante... ; by patrick_35 ; mods by beekeecz and bonuscad (vl-load-com) (defun c:surf_by_pt2xls ( / flag doc factor xls wks lin) (setq flag T doc (vla-get-activedocument (vlax-get-acad-object)) factor (getreal "\nFacteur multiplicatif à appliquer aux surfaces? <1>: ") ) (if (not factor) (setq factor 1.0)) (vla-startundomark doc) (setq xls (vlax-get-or-create-object "Excel.Application")) (or (setq wks (vlax-get xls 'ActiveSheet)) (vlax-invoke (vlax-get xls 'workbooks) 'Add) ) (setq wks (vlax-get xls 'ActiveSheet) lin 2 ) (vlax-put xls 'Visible :vlax-true) (vlax-put (vlax-get-property wks 'range "A1") 'value "Surface") (initget "Suivante Quitter _Next Quit") (while (/= (getkword "\nSurface [suivante/Quitter]? <Suivante>: ") "Quit") (command-s "_.Area") (while (not (zerop (getvar "CMDACTIVE"))) (command-s pause) ) (vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (* factor (getvar "AREA"))) (setq lin (1+ lin)) (initget "Suivante Quitter _Next Quit") ) (mapcar 'vlax-release-object (list wks xls)) (gc)(gc) (vla-endundomark doc) (princ) )

Bonjour, Aucun mérite, pompé sur un code de Patrick_35, juste réarrangé rapidement... ; by patrick_35 ; mods by beekeecz and bonuscad (vl-load-com) (defun c:metres ( / flag doc xls wks lin nam_lay l_cumul sel ent) (setq flag T doc (vla-get-activedocument (vlax-get-acad-object)) ) (vla-startundomark doc) (setq xls (vlax-get-or-create-object "Excel.Application")) (or (setq wks (vlax-get xls 'ActiveSheet)) (vlax-invoke (vlax-get xls 'workbooks) 'Add) ) (setq wks (vlax-get xls 'ActiveSheet) lin 2 ) (vlax-put xls 'Visible :vlax-true) (vlax-put (vlax-get-property wks 'range "A1") 'value "Type-Entité") (vlax-put (vlax-get-property wks 'range "B1") 'value "Calque") (vlax-put (vlax-get-property wks 'range "C1") 'value "Longueur") (while (setq def_lay (tblnext "LAYER" flag)) (setq nam_lay (cdr (assoc 2 def_lay)) flag nil l_cumul 0.0) (and (ssget "_X" (list (cons 0 "LWPOLYLINE") (cons 8 nam_lay))) (progn (vlax-for ent (setq sel (vla-get-activeselectionset doc)) (vlax-put (vlax-get-property wks 'range (strcat "A" (itoa lin))) 'value (vlax-get ent 'ObjectName)) (vlax-put (vlax-get-property wks 'range (strcat "B" (itoa lin))) 'value (vlax-get ent 'Layer)) (vlax-put (vlax-get-property wks 'range (strcat "C" (itoa lin))) 'value (read (rtos (setq e_length (vlax-get ent 'Length)) 2 2))) (setq lin (1+ lin) l_cumul (+ e_length l_cumul)) ) (vla-delete sel) ) ) (vlax-put (vlax-get-property wks 'range (strcat "C" (itoa lin))) 'value (read (rtos l_cumul 2 2))) (setq lin (1+ lin)) ) (mapcar 'vlax-release-object (list wks xls)) (gc)(gc) (vla-endundomark doc) (princ) )

Waoou! Très subtile l'usage de LASTPROMPT, fallait y penser... En plus cette variable est difficile à tester au pas à pas. Bien visé, merci pour cette proposition. ;)

Bonjour, Un membre m'avait demandé en mp une fonction un peu similaire. Je te poste le code complet en te suggérant de t'inspirer de la fonction nentsel-getreal du code, qui je pense pourrait répondre à ton besoin. (vl-load-com) (defun nentsel-getreal ( / ent key n nbr) (setq nbr "") (princ (strcat "\nChoisir le Texte/Texte Multiligne/Attribut pour obtenir le Z <" (rtos (caddr (getvar "LASTPOINT")) 2 2) ">: ")) (while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25) (/= (car key) 3)) (cond ((eq (car key) 2) (if (member (cadr key) '(8 46 48 49 50 51 52 53 54 55 56 57)) (if (eq (cadr key) 8) (progn (princ (chr 8)) (princ (chr 32)) (princ (chr 8)) (setq nbr (substr nbr 1 (1- (strlen nbr)))) ) (progn (setq n (chr (cadr key))) (princ n) (setq nbr (strcat nbr n)) ) ) ) ) ) ) (if (eq (car key) 3) (if (setq ent (nentselp (cadr key))) (progn (setq ent (entget (car ent))) (if (member (cdr (assoc 0 ent)) '("TEXT" "MTEXT" "ATTRIB")) (progn (setq ent (read (cdr (assoc 1 ent)))) (if (or (eq (type ent) 'INT) (eq (type ent) 'REAL)) (progn (princ (strcat "\nZ = " (rtos ent 2 2))) ent) (progn (princ "\nLe texte n'est pas valide!") (nentsel-getreal)) ) ) (progn (princ "\nObjet n'est pas un Texte!") (nentsel-getreal)) ) ) (progn (princ "\nSélection vide!") (setq ent nil) (nentsel-getreal)) ) (if (/= nbr "") (progn (princ (strcat "\nZ = " nbr)) (atof nbr)) (progn (princ (strcat "\nZ = " (rtos (caddr (getvar "LASTPOINT"))2 2))) (caddr (getvar "LASTPOINT"))) ) ) ) (defun c:3dpoly_xy ( / AcDoc Space msg_f msg_n n pt_f lst_pt lst_tmp pt_n nw_pl) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) msg_f "\nSpécifiez l'extrémité de la ligne .XY de, ou [annUler]: " msg_n "\nSpécifiez l'extrémité de la ligne .XY de, ou [Clore/annUler]: " n 0 ) (while (null (setq pt_f (getpoint "\nSpécifiez le point de départ de la polyligne: .XY de "))) (princ "\nPoint incorrect.") ) (setq pt_f (trans pt_f 1 0) lst_pt (list (list (car pt_f) (cadr pt_f) (nentsel-getreal))) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (initget "U ANNUler _Undo UNDO") (while (and (setq pt_n (getpoint (trans pt_f 0 1) (if (< n 2) msg_f msg_n))) (/= pt_n "Close")) (if (listp pt_n) (progn (setq pt_n (trans pt_n 1 0) lst_pt (cons (list (car pt_n) (cadr pt_n) (nentsel-getreal)) lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1+ n) pt_f pt_n) ) (if (zerop n) (princ "\nTous les segments sont déjà annulés.") (progn (setq lst_pt (cdr lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1- n) pt_f (getvar "lastpoint")) ) ) ) (if (< n 1) (initget "U ANNUler _Undo UNDO") (initget "U ANNUler Clore _Undo UNDO Close") ) (redraw) (while (cdr lst_tmp) (grdraw (trans (car lst_tmp) 0 1) (trans (cadr lst_tmp) 0 1) 7) (setq lst_tmp (cdr lst_tmp))) ) (redraw) (setq nw_pl (vlax-invoke Space 'Add3DPoly (apply 'append (reverse lst_pt)))) (if (eq pt_n "Close") (vlax-put nw_pl 'Closed 1) ) (princ) )

Bonjour, J'ai un souci un peu similaire avec mon W10 Pro (i5, Dell Latitude E6410), sauf que l'application Explorer se ferme mais se relance d'elle même: Pendant quelque secondes, mon bureau disparait (les icônes) puis se réactualise. Comme tu dis je n'ai pas de problème avec les applications déjà ouvertes. Pour essayer de résoudre le problème, j'ai regardé les événement système et régulièrement j'ai une erreur qui apparait: elle concerne DCOM (DistributedCOM), c'est la seule erreur que j'ai dans mon journal. J'ai essayé les solutions de Microsoft (changement de droits), mais ne peux les appliquer car la case reste grisée et non accessible. Ça concerne pour ma part le service "TrustedInstaller". D'après ce que j'ai compris c'est un service avec des droits réservé à Microsoft (Même l'administrateur ne peut y accéder, un comble...) implanté dans la version W10. Je ne puis affirmé que le problème vienne de là, mais en tout cas je n'ai pas pu le résoudre et continue à utiliser ma machine tel quelle! As tu la même sorte d'erreur dans ton journal?

Bonjour, Sur AutocaMap 2014 (Seven 64bit), ça rame grave: Autocad ne répond pas pendant au moins 10mn. Après avoir fait ce qui suit, la décomposition dure 10s.

Je ne suis par contre les remarques, mais il faut qu'elles soient argumentées... car vu que tu a repris presque intégralement mon code, je me sens visé. (defun c:conduite ( / blabla)): blabla ne sert pas à initialiser des variables, mais à les rendre locales. C'est à dire quand le programme est achevé, la variable blabla est remise à nil, autrement elle garde sa valeur même en dehors du programme. C'est une façon beaucoup plus propre qui économise la mémoire et évite des interactions avec d'autres programmes qui aurait l'utilisation des même nom de variables. Essayes la correction! (defun c:conduite ( / AcDoc Space msg_f msg_n n old_cutmnu old_plw old_osm pt_f lst_pt lst_tmp pt_n nw_pl key htx nw_style nw_obj pt rtx dxf_ent tmp deriv) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (eq (getvar "CVPORT") 1) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) msg_f "\nSpécifiez l'extrémité de la ligne ou [annUler]: " msg_n "\nSpécifiez l'extrémité de la ligne ou [Clore/annUler]: " n 0 old_cutmnu (getvar "SHORTCUTMENU") old_plw (getvar "PLINEWID") old_osm (getvar "OSMODE") ) (setvar "OSMODE" 5) (while (null (setq pt_f (getpoint "\nSpécifiez le point de départ de la polyligne: "))) (princ "\nPoint incorrect.") ) (setq pt_f (trans pt_f 1 0) lst_pt (list pt_f) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (initget "U ANNUler _Undo UNDO") (while (and (setq pt_n (getpoint (trans pt_f 0 1) (if (< n 2) msg_f msg_n))) (/= pt_n "Close")) (if (listp pt_n) (progn (setq pt_n (trans pt_n 1 0) lst_pt (cons pt_n lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1+ n) pt_f pt_n) ) (if (zerop n) (princ "\nTous les segments sont déjà annulés.") (progn (setq lst_pt (cdr lst_pt) lst_tmp lst_pt) (setvar "LASTPOINT" (car lst_pt)) (setq n (1- n) pt_f (getvar "lastpoint")) ) ) ) (if (< n 1) (initget "U ANNUler _Undo UNDO") (initget "U ANNUler Clore _Undo UNDO Close") ) (redraw) (while (cdr lst_tmp) (grdraw (trans (car lst_tmp) 0 1) (trans (cadr lst_tmp) 0 1) 7) (setq lst_tmp (cdr lst_tmp))) ) (redraw) (setq nw_pl (vlax-invoke Space 'AddLightWeightPolyline (apply 'append (mapcar 'list (mapcar 'car lst_pt) (mapcar 'cadr lst_pt))))) (if (eq pt_n "Close") (vlax-put nw_pl 'Closed 1) ) (setvar "SHORTCUTMENU" 11) (setvar "PLINEWID" 0.0) (if (not (eq (substr (getvar "USERS1") 1 3) "plw")) (setvar "USERS1" "plw0.0") ) (initget 4) (setq key (getreal (strcat "\nDiamètre souhaité (Epaisseur de la polyligne canalisation en Centimètre) <" (itoa (fix (atof (substr (getvar "USERS1") 4 5)))) ">?: "))) (if key (setvar "USERS1" (strcat "plw" (rtos Key 2 1)))) ; Initialise le diamètre à key ; DIAMETRE A RENTRER EN METRE ; PROBLEME DE RETRANSCRIPTION SI DIAMETRE 250 ALORS IL M'AFFICHERA EN TEXTE 300 (vlax-put nw_pl 'ConstantWidth (* (atof (substr (getvar "USERS1") 4 5)) 0.001)) ; LA CANALISATION SE MET DONC EN 0.3 AU LIEU DE 0.25 (initget "PVC BETON PEHD") (setq key (getkword "\nType de conduite [PVC/BETON/PEHD]?: ")) ; Initialise le type de conduite à KEY (cond ((null (tblsearch "LAYER" "CANALISATION")) ; (vla-add (vla-get-layers AcDoc) "CANALISATION") ; ) ; Il faudrait pouvoir le mettre directement dans un calque prédéfini " CANALISATION" ) ; (vlax-put nw_pl 'Layer "CANALISATION") ; (cond ; ((null (tblsearch "STYLE" "CONDUITE")) ; (setq nw_style (vla-add (vla-get-textstyles AcDoc) "CONDUITE")) ; (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) ) ) ) (initget 6) (setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpécifiez la hauteur du texte <" (rtos (getvar "TEXTSIZE")) ">: "))) ; Donner la hauteur du texte (if htx (setvar "TEXTSIZE" htx)) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (getvar "TEXTSIZE")))) (setq rtx 0.0) (strcat key " -Tuyau- " ; ou tout autres textes ou supprimer la ligne pour aucun texte " %%C:" "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID nw_pl)) ">%).ConstantWidth \\f \"%lu2%pr0%ct8[1000]\">%" ; facteur de 1000 pour retrouver le diamètre original " L = " "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID nw_pl)) ">%).Length \\f \"%lu2%pr1\">%" "m" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) ;IL ME FAUDRAIT METTRE LE TEXTE DANS LE CALQUE QUI LUI EST PROPRE (list 5 (getvar "TEXTSIZE") 5 pt "CONDUITE" "CANALISATION" rtx) ) ; IMPOSSIBLE DE TROUVER COMMENT DECALER PLUS LE TEXTE PAR RAPPORT A LA POLYLIGNE (setq dxf_ent (entget (entlast))) ; ARRIVE A UNE CERTAINE VALEUR, LE TEXTE EST ILLISIBLE, MORDU PAR LA POLYLIGNE (while (or (= 5 (car (setq tmp (grread t 5 1)))) (/= (car tmp) 25) (= (car tmp) 3)) (cond ((= 5 (car tmp)) (setq pt (vlax-curve-getClosestPointTo nw_pl (trans (cadr tmp) 1 0)) deriv (vlax-curve-getFirstDeriv nw_pl (vlax-curve-GetParamAtPoint nw_pl pt)) rtx (- (atan (cadr deriv) (car deriv)) (angle '(0 0 0) (getvar "UCSXDIR"))) ) (if (or (> rtx (* pi 0.5)) (< rtx (- (* pi 0.5)))) (setq rtx (+ rtx pi))) (entmod (subst (cons 50 rtx) (assoc 50 dxf_ent) (subst (cons 10 (polar pt (+ rtx (* pi 0.5)) (+ (* (atof (substr (getvar "USERS1") 4 5)) 0.001) (getvar "TEXTSIZE")))) (assoc 10 dxf_ent) dxf_ent) ) ) (entupd (cdar dxf_ent)) ) ((= 3 (car tmp)) (setq nw_obj (vla-addMtext Space (vlax-3d-point (setq pt (polar '(0.0 0.0 0.0) (* pi 0.5) (+ (* (atof (substr (getvar "USERS1") 4 5)) 0.001) (getvar "TEXTSIZE"))))) (setq rtx 0.0) (strcat key " -Tuyau- " ; ou tout autres textes ou supprimer la ligne pour aucun texte " %%C:" "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID nw_pl)) ">%).ConstantWidth \\f \"%lu2%pr0%ct8[1000]\">%" ; facteur de 1000 pour retrouver le diamètre original " L = " "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID nw_pl)) ">%).Length \\f \"%lu2%pr1\">%" "m" ) ) ) (mapcar '(lambda (pr val) (vlax-put nw_obj pr val) ) (list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation) (list 5 (getvar "TEXTSIZE") 5 pt "CONDUITE" "CANALISATION" rtx) ) (setq dxf_ent (entget (entlast))) ) (T (princ "\nArrêt anormal de la commande ")) ) ) (entdel (entlast)) (setvar "PLINEWID" old_plw) (setvar "SHORTCUTMENU" old_cutmnu) (setvar "OSMODE" old_osm) (princ) )

Pour reprendre le concept de DenisHen (qui évite le (cond ...) La séquence pourrait être écrite comme suit: (if (not (eq (substr (getvar "USERS1") 1 3) "plw")) (setvar "USERS1" "plw0") ) (initget "0 100 200 250 500 750") (setq key (getkword (strcat "\nDiamètre souhaité [0/100/200/250/500/750] <" (itoa (fix (* 100 (atof (substr (getvar "USERS1") 4 3))))) ">?: "))) (if key (setvar "USERS1" (strcat "plw" (rtos (/ (atoi Key) 100.0) 2 1)))) (vlax-put nw_pl 'ConstantWidth (atof (substr (getvar "USERS1") 4))) ou si tu préfère (getint) pour entroduire un diamètre sous forme d'entier. (if (not (eq (substr (getvar "USERS1") 1 3) "plw")) (setvar "USERS1" "plw0") ) (initget 4) (setq key (getint (strcat "\nDiamètre souhaité <" (itoa (fix (* 100 (atof (substr (getvar "USERS1") 4 3))))) ">?: "))) (if key (setvar "USERS1" (strcat "plw" (rtos (/ Key 100.0) 2 1)))) (vlax-put nw_pl 'ConstantWidth (atof (substr (getvar "USERS1") 4)))

Je comprends bien, mais n'as tu pas placé la barre un peu haut? Et ça je ne sais le faire qu'avec des fonctions vla, donc c'est pour ça que je te les ais proposées. Un truc sympa qui peut t'aider en vla: une fonction dump & dumpn Ca te permettra de connaitre les propriétés accessible d'un objet...

Par exemple: Changer dans le code (initget "0 2.5 5 7.5 10") (setq key (getkword (strcat "\nDiamètre souhaité [0/2.5/5/7.5/10] <" (substr (getvar "USERS1") 4 3) ">?: "))) (cond ((eq key "0") (setvar "USERS1" "plw0")) ((eq key "2.5") (setvar "USERS1" "plw2.5")) ((eq key "5") (setvar "USERS1" "plw5")) ((eq key "7.5") (setvar "USERS1" "plw7.5")) ((eq key "10") (setvar "USERS1" "plw10")) ) Par (initget "0 100 200 250 500 750") (setq key (getkword (strcat "\nDiamètre souhaité [0/100/200/250/500/750] <" (substr (getvar "USERS1") 4 3) ">?: "))) (cond ((eq key "0") (setvar "USERS1" "plw0")) ((eq key "100") (setvar "USERS1" "plw0.1")) ((eq key "200") (setvar "USERS1" "plw0.2")) ((eq key "250") (setvar "USERS1" "plw0.25")) ((eq key "500") (setvar "USERS1" "plw0.5")) ((eq key "750") (setvar "USERS1" "plw0.75)) ) changer dans le code (2 occurences] (strcat "Conduite-" key " %%C:" "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID nw_pl)) ">%).ConstantWidth \\f \"%lu2%pr1\">%" " L = " "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID nw_pl)) ">%).Length \\f \"%lu2%pr1\">%" "m" ) par (strcat key "Tuyau-" ; ou tout autres textes ou supprimer la ligne pour aucun texte " %%C:" "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID nw_pl)) ">%).ConstantWidth \\f \"%lu2%pr0%ct8[1000]\">%" ; facteur de 1000 pour retrouver le diamètre original " L = " "%<\\AcObjProp Object(%<\\_ObjId " (itoa (vla-get-ObjectID nw_pl)) ">%).Length \\f \"%lu2%pr1\">%" "m" ) Je crois que tu n'as pas saisi la subtilité lors de l'utilisation du code. Lorsque tu as valider ta hauteur de texte, le texte apparait, sans rien valider BOUGE TON CURSEUR, tu peux positionner l'emplacement avec un clic-gauche de ton texte le long de ta polyligne. Un texte apparait de nouveau que tu peux aussi positionner ou alors un clic-droit pour mettre fin. Tu peux ainsi mettre autant de textes répétitif que tu veux le long de ta polyligne.

Je pense à la variable SHORTCUTMENU. Par défaut elle est à 11, si valeur différente elle peut influer sur le comportement de initget pour le menu contextuel.

Bonjour, Il me semble que "_xplode" est un outil des express tools, ceux -ci sont-ils correctement installés sous ta 2017? Si par le passé c'était un fichier .lsp, maintenant je crois que c'est devenu un arx contenu dans le fichier acetutil.arx Bon la réponse ne vas pas résoudre ton problème et comme je n'ai pas 2017, je ne peux pas testé. Mais à priori les options ne sont pas les mêmes entre ces 2 commandes.

La suggestion de sauvegarde en DXF de Didier peut être intéressante. Mais une précision (qui peut faire la différence): Lorsque tu es dans la boite de dialogue "Enregistrer le dessin sous", je te recommande de cliquer sur le pop_up déroulant "Outils" (en haut à gauche de la boite de dialogue) et dans le menu qui s'affiche de choisir "Options..." Dans cette nouvelle boite qui apparait, cliquer sur l'onglet "Options DXF" et enfin COCHER la case "Sélectionner les objets". Tu pourras alors sélectionner Tout les objets de ton dessin pour faire la sauvegarde. Pourquoi cette manip? Elle évite l'import dans le DXF de toutes les TABLES, STYLES, DICTIONNAIRES etc... qui ne sont pas concernées par tes objets sélectionnés. Si tu ne fais pas par sélection, par défaut toutes les tables de définitions du dessin (même non utilisées) sont aussi exportés, donc bénéfice nul.

Regarder éventuellement les objets AEC si ton fichier est passé par un produit transversal d'AutoDesk. Faire une recherche sur le site de CadXp avec "removeAEC" par exemple. Il peut y avoir aussi des entités "Zombie". Bref ces trucs peuvent pourrir un dessin en temps de réponse. Ce problème je l'avais rencontré dans le passé avec un driver de carte graphique pas adapté ou mal configuré, je ne sais plus, mais c'était bien lié à la carte graphique. Une autre piste peut être!

Une tentative d'épure, le barreaudage c'est pas mon rayon. Si d'autres veulent creuser... NB: C'est en millimètre, ça peut se changer. (defun z_dir (p1 p2 / ) (trans '(0.0 1.0 0.0) (mapcar '(lambda (k) (/ k (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) (mapcar '- p2 p1) ) ) ) ) ) (mapcar '- p2 p1) ) 0 ) ) (defun c:barreaudage ( / sect d_tub h_bar x_sect y_sect dlt js ent dxf_ent vlaobj lg_obj div inc_dist partial_dist pt_start pt_end lst_pt ang dxf_210) (setq sect (getpoint "\nSection de votre barreaudage (ou <18,0> pour diamètre tube)? <18,18>: ")) (if (not sect) (setq sect '(18.0 18.0 0.0))) (if (zerop (cadr sect)) (setq d_tub (car sect) x_sect (car sect) sect nil) (setq d_tub nil x_sect (car sect) y_sect (cadr sect) dlt (* 0.5 (sqrt (+ (* x_sect x_sect) (* y_sect y_sect))))) ) (setq h_bar (getdist "\nHauteur du barreaudage? <900.0>: ")) (if (not h_bar) (setq h_bar 900.0)) (princ "\nChoix de l'objet à mesurer: ") (while (not (setq js (ssget "_+.:E:S" (list (cons 0 "*POLYLINE,LINE,ARC") (cons -4 "<NOT") (cons -4 "&") (cons 70 112) (cons -4 "NOT>") ) ) ) ) ) (setq ent (ssname js 0) dxf_ent (entget ent) vlaobj (vlax-ename->vla-object ent) ) (redraw ent 3) (if (vlax-property-available-p vlaobj 'Length) (setq lg_obj (vlax-get vlaobj 'Length)) (setq lg_obj (vlax-get vlaobj 'ArcLength)) ) (setq div (1+ (fix (/ lg_obj (+ 110.0 x_sect)))) inc_dist (/ lg_obj div) partial_dist inc_dist pt_start (vlax-curve-getStartPoint vlaobj) pt_end (vlax-curve-getEndPoint vlaobj) lst_pt (list pt_start) ) (while (< partial_dist lg_obj) (setq lst_pt (cons (vlax-curve-getPointAtDist vlaobj partial_dist) lst_pt) partial_dist (+ partial_dist inc_dist) ) ) (setq lst_pt (reverse (cons pt_end lst_pt))) (foreach n lst_pt (setq ang (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv vlaobj (vlax-curve-getParamAtPoint vlaobj n))) dxf_210 (z_dir n (polar n ang inc_dist)) ) (if d_tub (entmake (list '(0 . "CIRCLE") '(100 . "AcDbEntity") (assoc 67 dxf_ent) (assoc 410 dxf_ent) (cons 8 (getvar "CLAYER")) '(100 . "AcDbCircle") (cons 39 h_bar) (cons 10 n) (cons 40 (* d_tub 0.5)) (cons 210 dxf_210) ) ) (entmake (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (assoc 67 dxf_ent) (assoc 410 dxf_ent) (cons 8 (getvar "CLAYER")) '(100 . "AcDbPolyline") '(90 . 4) '(70 . 1) '(43 . 0.0) (cons 38 (caddr n)) (cons 39 h_bar) (cons 10 (polar n (+ ang (- (* 1.5 pi) (atan (/ x_sect y_sect)))) dlt)) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0) (cons 10 (polar n (+ ang (* 1.5 pi) (atan (/ x_sect y_sect))) dlt)) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0) (cons 10 (polar n (+ ang (- (* 0.5 pi) (atan (/ x_sect y_sect)))) dlt)) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0) (cons 10 (polar n (+ ang (* 0.5 pi) (atan (/ x_sect y_sect))) dlt)) '(40 . 0.0) '(41 . 0.0) '(42 . 0.0) '(91 . 0) (cons 210 dxf_210) ) ) ) ) (redraw ent 4) (prin1) ) Modifications apportées: * Possibilité de section carré ou tube. * Mise en hauteur des barreaux générés * Correction pour optimisation distance inter-barreaux (< 110 mm)

Bonjour, A minima pour la partie INCTXT, je modifierais la partie (entmake ....), ici la ligne 573. A la place je mettrais ceci: (+ (if (not (setq rop (getangle (trans pt 0 1) (strcat "\nAngle du texte <" (angtos ro) ">:")))) ro rop) (angle '(0 0 0) (trans (getvar "UCSXDIR") 0 nor))) C'est vraiment à minima et j'espère que je ne massacre pas le code de (gile), c'est pour ça que je te laisse le soin de faire la modif toi-même. :P De cette manière lors de l'insertion l'angle par défaut (de la boite de dialogue) est proposé, soit tu valide à blanc, soit tu entre un autre ponctuellement (graphiquement ou numériquement). Peut être que quelqu'un d'autre aura mieux à te proposer...

En regardant l'aide, c'est la variable PDFOSNAP devenue UOSNAP (valeur 1 par défaut, 0 désactivé) Donc à regarder en priorité, même si OSNAP est bien elle aussi à 0.

Bonjour, Peut être que si les PDF ont une origine vectorielle, penser à désactiver l'accroche objet. En effet dans ce type de PDF on peut s'accrocher, mais j'ai remarquer que c'était au dépend de la réactivité, on a l'impression qu'il fouille à chaque fois le PDF pour sortir une accroche correspondante demandée, donc si l'accroche est activée en permanence, ça lague.... surtout si le PDF est un peu lourd.

Lorsque tu insère ton champ, prends la catégorie "VariableSystème" et choisis "ctab" Ton champ prendra en dynamique le nom de l'onglet papier, même si tu change le nom de celui après coup.

Autrement en commande additionnelle en natif tu as la commande "MOCORO" (pour MOve/COpy/ROtate & SCale en +) qui fait ce que tu relate...:

Bonjour, Et si dans ton script du mettais "FILEDIA" à "0" Et ensuite tu utilise la commande "_.-XREF" et l'option "_ATTACH" ça devrait passer en script!