lecrabe

Hello Youpee j ai commente les lignes de la routine qui generaient potentiellement UNE Cote angulaire !? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite ;; ;; 01/09/2020 variante de la Routine LW_DIM par GC ;; https://cadxp.com/topic/49272-lisp-cotation/page__pid__295695 ;; Amelioration par VDH-Bruno ;; Pour coter N Polylignes "legeres" (et non pas UNE Seule) en mode ALIGNE ;; Avec le style de Cotation COURANT ;; ;; Micro-Bug : si PLines Closes alors generation de UNE Cotation Angulaire sur le Vertex 1 ! ;; Micro-Bug : corrige ... N lignes en commentaires ! ;; (defun c:nLw_Dim__v1 (/ js Lw_Dim_1 ssmap AcDoc Space) ;; Fonctions auxiliaire (defun ssmap (fun ss / n) (if (= 'PICKSET (type ss)) (repeat (setq n (sslength ss)) (apply fun (list (ssname ss (setq n (1- n))))) ) ) ) (defun Lw_Dim_1 (ent / dxf_ent lst_pt) (setq dxf_ent (entget ent) lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent) ) ) ) (if (= 1 (logand 1 (cdr (assoc 70 dxf_ent)))) (setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt)))) ) ; (if (equal (car lst_pt) (last lst_pt) 1e-9) ; (vla-addDimAngular ; Space ; (vlax-3d-point (car lst_pt)) ; (vlax-3d-point (cadr (reverse lst_pt))) ; (vlax-3d-point (cadr lst_pt)) ; (vlax-3d-point ; (polar ; (car lst_pt) ; (angle ; (car lst_pt) ; (mapcar '* ; (mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt)) ; '(0.5 0.5 0.5) ; ) ; ) ; (* 10 (getvar "DIMTXT")) ; ) ; ) ; ) ; ) (while (cdr lst_pt) (vla-addDimAligned Space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (polar (mapcar '* (mapcar '+ (car lst_pt) (cadr lst_pt)) '(0.5 0.5 0.5) ) (+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5)) (* 10 (getvar "DIMTXT")) ) ) ) (setq lst_pt (cdr lst_pt)) ) ) ;; Programme principal (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) ) ) (princ "\Generation de N Cotations alignees \nSelectionner les Polylignes 2D (LWPline) a coter ... " ) (if (setq js (ssget '((0 . "LWPOLYLINE")))) ;; (ssmap 'Lw_Dim js) (ssmap 'Lw_Dim_1 js) ) (prin1) )

Hello Idee rapide sans reflechir ! As tu essaye avec EXPERT = 5 !? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello Drault & Bruno Merci Bruno ! Donc voici la version (Routine : "nLw_Dim__v2") qui genere des Cotes ALIGNEES ET ANGULAIRES sur N Polylignes 2D (LWPlines) ... ---- Pour Bruno : la routine de Gilles (Cotes alignees seulement) a un Micro-Bug ! ---- Elle genere UNE Cote angulaire (Au vertex 1) si la Polyligne est Close ! ---- Avec mon niveau 0.1 en Lisp, je ne sais pas du tout corriger ce Micro-Bug ! ---- A priori c corrige ! Voir mon message suivant ... LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite ;; ;; 01/09/2020 variante de la Routine LW_DIM par GC ;; Amelioration par VDH-Bruno ;; Pour coter N Polylignes "legeres" (et non pas UNE Seule) ;; ---- en mode ALIGNE + en mode ANGULAIRE ---- ;; Avec le style de Cotation COURANT ;; ;(defun c:nLw_Dim__v2 (/ js Lw_Dim ssmap AcDoc Space) (defun c:nLw_Dim__v2 (/ js Lw_Dim_2 ssmap AcDoc Space) ;; Fonctions auxiliaire (defun ssmap (fun ss / n) (if (= 'PICKSET (type ss)) (repeat (setq n (sslength ss)) (apply fun (list (ssname ss (setq n (1- n))))) ) ) ) ; (defun Lw_Dim (ent / dxf_ent lst_pt) (defun Lw_Dim_2 (ent / dxf_ent lst_pt) (setq dxf_ent (entget ent) lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent) ) ) ) (if (= 1 (logand 1 (cdr (assoc 70 dxf_ent)))) (setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt)))) ) (if (equal (car lst_pt) (last lst_pt) 1e-9) (vla-addDimAngular Space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr (reverse lst_pt))) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) (mapcar '* (mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt)) '(0.5 0.5 0.5) ) ) (* 10 (getvar "DIMTXT")) ) ) ) ) (while (cdr lst_pt) (vla-addDimAligned Space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (polar (mapcar '* (mapcar '+ (car lst_pt) (cadr lst_pt)) '(0.5 0.5 0.5) ) (+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5)) (* 10 (getvar "DIMTXT")) ) ) ) (if (cddr lst_pt) (vla-addDimAngular Space (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (car lst_pt)) (vlax-3d-point (caddr lst_pt)) (vlax-3d-point (polar (cadr lst_pt) (angle (cadr lst_pt) (mapcar '* (mapcar '+ (caddr lst_pt) (car lst_pt)) '(0.5 0.5 0.5) ) ) (* 10 (getvar "DIMTXT")) ) ) ) ) (setq lst_pt (cdr lst_pt)) ) ) ;; Programme principal (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) ) ) (princ "\Generation de N Cotations alignees + angulaires \nSelectionner les Polylignes 2D (LWPline) a coter ... " ) (if (setq js (ssget '((0 . "LWPOLYLINE")))) ;; (ssmap 'Lw_Dim js) (ssmap 'Lw_Dim_2 js) ) (prin1) )

Hello C SURTOUT Gilles qu il faut remercier !! Routine "LW_DIM__v2" de Gilles qui en plus des cotes alignees , realise les cotes angulaires sur tous les angles ! ---- Au fait SVP si qq un pouvait faire une petite amelioration sur la routine de Gilles !? ---- Traiter N PLines 2D et non pas UNE SEULE !! LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite ;; Routine LW_DIM__v2 par GC ;; pour coter une polyligne ;; en mode ALIGNE & ANGULAIRE ;; Avec le style de Cotation COURANT (defun c:Lw_Dim__v2 (/ js ent dxf_ent lst_pt AcDoc Space) (princ "\nSelectionner la Polyligne 2D (LWPline) a coter ... ") (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))) (cond (js (vl-load-com) (setq dxf_ent (entget (setq ent (ssname js 0))) lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent) ) ) ) (if (= 1 (logand 1 (cdr (assoc 70 dxf_ent)))) (setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt)))) ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (if (equal (car lst_pt) (last lst_pt) 1e-9) (vla-addDimAngular Space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr (reverse lst_pt))) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) (mapcar '* (mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt)) '(0.5 0.5 0.5) ) ) (* 10 (getvar "DIMTXT")) ) ) ) ) (while (cdr lst_pt) (vla-addDimAligned Space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (polar (mapcar '* (mapcar '+ (car lst_pt) (cadr lst_pt)) '(0.5 0.5 0.5) ) (+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5)) (* 10 (getvar "DIMTXT")) ) ) ) (if (cddr lst_pt) (vla-addDimAngular Space (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (car lst_pt)) (vlax-3d-point (caddr lst_pt)) (vlax-3d-point (polar (cadr lst_pt) (angle (cadr lst_pt) (mapcar '* (mapcar '+ (caddr lst_pt) (car lst_pt)) '(0.5 0.5 0.5) ) ) (* 10 (getvar "DIMTXT")) ) ) ) ) (setq lst_pt (cdr lst_pt)) ) ) ) (prin1) )

Hello Veux tu appliquer / transférer le style de UN Texte sélectionné vers UN ou N attribut(s) ou Tous les attributs du meme bloc puis Synchronisation du bloc considéré ?! LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello A priori qq un qui n est pas du tout AutoCAD, MicroStation, Revit, Archicad, AllPlan, etc DONC "vu de loin" , je penche pour Sketchup ! + Enscape eventuellement (Conseil d ami) !? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello C SURTOUT Gilles qu il faut remercier !! ET j ai la meme routine "LW_DIM__v2" de Gilles qui en plus des cotes alignees , realise les cotes angulaires sur tous les angles ! Ca t interesse !? ---- Au fait SVP si qq un pouvait faire une petite amelioration sur la routine de Gilles !? ---- Traiter N PLines 2D et non pas UNE SEULE !! LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello La question est dans le titre ! SVP vous conseillerez quoi comme logiciel 3D pour un decorateur d interieur ?? Modelisez vite en 3D ... La precision n est pas primordiale !? Mettre des jolis textures / materiaux ... etc Meubles, Peintures, Tapisseries, Tapis, Carrelages, Revetements, Rideaux, Portes, Fenetres, Baies vitrees, Escaliers, etc ... En resume faire des jolies propositions 3D "SEXY" et "rapides" pour convaincre le client !? Batiments, Villas, Appartements, etc ... LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello Encore MERCI Gilles ! Alors et si tu essayais cette routine "LW_DIM" pour une LWPOLYLINE 2D !? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite ;; Routine LW_DIM par GC ;; pour coter une polyligne "legere" en mode ALIGNE ;; Avec le style de Cotation COURANT (defun c:Lw_Dim (/ js ent dxf_ent lst_pt AcDoc Space) (princ "\nSelectionner la Polyligne 2D (LWPline) a coter ... ") (setq js (ssget "_+.:E:S" '((0 . "LWPOLYLINE")))) (cond (js (vl-load-com) (setq dxf_ent (entget (setq ent (ssname js 0))) lst_pt (mapcar '(lambda (x) (trans x ent 0)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent) ) ) ) (if (= 1 (logand 1 (cdr (assoc 70 dxf_ent)))) (setq lst_pt (reverse (cons (car lst_pt) (reverse lst_pt)))) ) (setq AcDoc (vla-get-ActiveDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-ModelSpace AcDoc) ) ) (if (equal (car lst_pt) (last lst_pt) 1e-9) (vla-addDimAngular Space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr (reverse lst_pt))) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (polar (car lst_pt) (angle (car lst_pt) (mapcar '* (mapcar '+ (cadr (reverse lst_pt)) (cadr lst_pt)) '(0.5 0.5 0.5) ) ) (* 10 (getvar "DIMTXT")) ) ) ) ) (while (cdr lst_pt) (vla-addDimAligned Space (vlax-3d-point (car lst_pt)) (vlax-3d-point (cadr lst_pt)) (vlax-3d-point (polar (mapcar '* (mapcar '+ (car lst_pt) (cadr lst_pt)) '(0.5 0.5 0.5) ) (+ (angle (car lst_pt) (cadr lst_pt)) (* pi 0.5)) (* 10 (getvar "DIMTXT")) ) ) ) (setq lst_pt (cdr lst_pt)) ) ) ) (prin1) )

Hello Comment importes tu tes Fichiers SIG ESRI Shape dans AutoCAD ? Ou alors as tu un AutoCAD MAP (ou AutoCAD CIVIL) ? Si OUI, tu dois utiliser la commande MAPIMPORT !? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello Je disais Texte statique par opposition à une Cotation dynamique (associée à la Géométrie) ! LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello NON c par le REGRETTE Patrick_35 !! J utilise très souvent cette routine qui génère des Textes statiques... LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello Et voici encore 1 Lisp "Slope3D" (relatif aux problemes de Pente 3D) de BeeKeeCZ ... Tu cliques 2 Points en 3D ... Et il indique la Pente 3D en % ... ---- SVP tu nous diras si cela fonctionne bien !? ---- ET si OUI sur quelle version de AutoCAD ?? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite ;; ;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/label-slope/m-p/1787900/highlight/true#M224078 ;; ;; Routine Slope3D by BeekeeCZ -- Use SNAP to EndPoint (Accrochage EXTremite) ;; ;; Micro-Modif par Patrice B. pour avoir seulement un Texte de Pourcentage de Pente ;; ;; Voir TEXTSIZE pour la Hauteur par defaut du texte genere ... ;; ;; A PRIORI OK avec Style de Courant et Hauteur = ZERO ou xx.xx ;; (defun c:Slope3D ( / pt1 pt2 h1 h2 d12 ang ptm arr) (if (and (setq pt1 (getpoint "\nChange TEXTSIZE Before (Avant) if necessary\nPick first 3D Point: ")) (setq pt2 (getpoint pt1 "\nPick second 3D Point: ")) (not (equal pt1 pt2)) (setq h1 (last pt1) h2 (last pt2) pt1 (reverse (cdr (reverse pt1))) pt2 (reverse (cdr (reverse pt2))) d12 (distance pt1 pt2) ang (angle pt1 pt2) ptm (polar pt1 ang (/ d12 2)))) (progn (setq arr (cond ((= slp 0) 0) ((< (- h1 h2) 0.) -1) (1))) (if (< (* pi 0.5) ang (* pi 1.5)) (setq ang (+ ang pi) arr (* arr -1))) (entmakex (list (cons 00 "TEXT") (cons 10 (trans ptm 1 0)) (cons 11 (trans ptm 1 0)) (cons 01 (strcat (rtos (abs (* (/ (- h1 h2) d12) 100)) 2 2) "%")) (cons 07 (getvar 'TEXTSTYLE)) (cons 40 (getvar 'TEXTSIZE)) (cons 50 (angle (trans '(0 0 0) 1 0) (trans (polar '(0 0 0) ang 1e6) 1 0))) ; by John Uhden (cons 72 1) (cons 73 1) )) ;; (command ;; "_-text" "_j" "_bc" "_none" ptm 1 (angtos ang) (strcat (rtos (abs (* (/ (- h1 h2) d12) 100)) 2 2) "%") ;; "_-insert" ( strcat ; "c:/Users/Beekee/AppData/Local/Autodesk/AutoCAD 2015/R20.0/enu/Support/" "Arrow" (itoa arr) ".dwg") "_none" ptm (getvar 'TEXTSIZE) "" (angtos ang) ;; ) ) ) (princ) )

Hello Et voici encore 2 Lisp (relatifs aux problemes de Pente 3D) de Gilles tires de mon stock de qq milliers de routines ... SVP tu lis bien les commentaires et tu verras la difference entre les 2 routines (de 06/2016) !! ---- SVP tu nous diras si cela fonctionne bien !? ---- ET si OUI sur quelle version de AutoCAD ?? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite ;; ;; http://forums.autodesk.com/t5/autocad-francais/connaitre-la-pente-de-la-partie-courbe-d-une-polyligne-3d/td-p/6345605 ;; ;; Routine pour: Furtiffl ;; ;; Routine: PentePoly3D v1 par GC ;; (defun c:PentePoly3D (/ sel pl3d elst pt1 pt2 dist deniv) (vl-load-com) (and (setq sel (entsel "\nSelectionnez une Polyligne 3D: ")) (setq pl3d (car sel)) (setq elst (entget pl3d)) (= (cdr (assoc 0 elst)) "POLYLINE") (= 8 (logand 8 (cdr (assoc 70 elst)))) (setq pt1 (getpoint "\nSpecifiez le premier point: ")) (setq pt2 (getpoint "\nSpecifiez le deuxième point: ")) (setq pt1 (vlax-curve-getClosestPointTo pl3d (trans pt1 1 0)) pt2 (vlax-curve-getClosestPointTo pl3d (trans pt2 1 0)) dist (abs (- (vlax-curve-getDistAtPoint pl3d pt1) (vlax-curve-getDistAtPoint pl3d pt2))) deniv (- (caddr pt2) (caddr pt1)) ) (prompt (strcat "\nLongueur : " (rtos dist 2 2) "\tDenivele = " (rtos deniv 2 2) "\tPente : " (rtos (/ (* 100. deniv) dist) 2 2) "%" ) ) ) (princ) ) ;; ;; http://forums.autodesk.com/t5/autocad-francais/connaitre-la-pente-de-la-partie-courbe-d-une-polyligne-3d/td-p/6345605 ;; ;; Routine pour: Furtiffl ;; ;; Routine: PentePoly3D v2 par GC ;; ;; la solution de _gile, c'est exactement ce qu'il me fallait ;; mais je m'aperçois que je me suis trompé dans mon exemple : ;; la longueur à calculer n'est pas 20m mais 17.9m ;; (c'est à dire la longeur plane de la polyligne (voir l'image)). ;; (defun c:PentePoly3D (/ flat sel pl3d elst pt1 pt2 pa1 pa2 deniv comp inc dist) (vl-load-com) (defun flat (p) (list (car p) (cadr p) 0.0)) (if (and (setq sel (entsel "\nSelectionnez une Polyligne 3D: ")) (setq pl3d (car sel)) (setq elst (entget pl3d)) (= (cdr (assoc 0 elst)) "POLYLINE") (= 8 (logand 8 (cdr (assoc 70 elst)))) (setq pt1 (getpoint "\nSpecifiez le premier point: ")) (setq pt2 (getpoint "\nSpecifiez le deuxième point: ")) ) (progn (setq pt1 (vlax-curve-getClosestPointTo pl3d (trans pt1 1 0)) pt2 (vlax-curve-getClosestPointTo pl3d (trans pt2 1 0)) pa1 (vlax-curve-getParamAtPoint pl3d pt1) pa2 (vlax-curve-getParamAtPoint pl3d pt2) deniv (- (caddr pt2) (caddr pt1)) ) (if (< pa1 pa2) (setq comp < inc 1+ pa1 (1+ (fix pa1)) ) (setq comp > inc 1- pa1 (fix pa1) ) ) (setq dist 0.0) (while (comp pa1 pa2) (setq dist (+ dist (distance (flat pt1) (flat (setq pt1 (vlax-curve-getPointAtParam pl3d pa1)))) ) pa1 (inc pa1) ) ) (setq dist (+ dist (distance (flat pt1) (flat pt2)))) (prompt (strcat "\nLongueur PLANE : " (rtos dist 2 2) "\tDenivele = " (rtos deniv 2 2) "\tPente : " (rtos (/ (* 100. deniv) dist) 2 2) "%" ) ) ) ) (princ) )

Hello Et voici encore 2 Lisp (relatifs aux problemes de Pente) tires de mon stock de qq milliers de routines ... MERCI a Bruno & Gilles et autres Super-Developpeurs ... PENTE (de Bruno) dessine une ligne devant avec une pente de xx.yy % ... PENTEPC (de Gilles) ecrit un texte simple par rapport a 2 Points cliques, qui indique la Pente en % LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite ;; ;; http://cadxp.com/topic/36187-dessiner-une-pente-en-pourcentage/page__pid__210618__st__20 ;; Par Bonuscad vs 1.00 ;; Version simplifiee de l ancien programme Pente de Bonuscad ;; (defun errlsp (ch) (cond ((eq ch "Function cancelled") nil) ((eq ch "quit / exit abort") nil) ((eq ch "console break") nil) (T (princ ch)) ) (setvar "cmdecho" v1) (setvar "orthomode" v2) (setvar "osmode" v3) (setvar "blipmode" v4) (setvar "snapang" v5) (setq *error* olderr) (princ) ) (defun C:PENTE ( / v1 v2 v3 v4 v5 d_pc p_o p_f dlt_x d olderr) (setq v1 (getvar "cmdecho") v2 (getvar "orthomode") v3 (getvar "osmode") v4 (getvar "blipmode") v5 (getvar "snapang") ) (setvar "cmdecho" 0) (setvar "orthomode" 0) (setvar "blipmode" 0) (setq olderr *error* *error* errlsp) (initget 1) (setq d_pc (getreal "\nEntrer la valeur de la Pente (Rampe) en % ?: ")) (initget 8) (setq p_o (getpoint "\nPoint de Depart : ")) (if (eq p_o ()) (setq p_o (getvar "lastpoint"))) (setvar "snapang" (atan (/ d_pc 100.0))) (setvar "orthomode" 1) (initget 41) (setq p_f (getpoint p_o "\nPoint Final : ")) (setvar "osmode" (+ 16384 (rem (getvar "osmode") 16384))) (setq dlt_x (- (car p_f) (car p_o))) (setq d (/ dlt_x (cos (atan (/ d_pc 100.0))))) (command "_.line" p_o (polar p_o (atan (/ d_pc 100.0)) d) "") (setvar "cmdecho" v1) (setvar "orthomode" v2) (setvar "osmode" v3) (setvar "blipmode" v4) (setvar "snapang" v5) (setq *error* olderr) (prin1) ) ;; Cree un objet texte le long de la pente ;; Il suffit de cliquer 2 points ;; Par GC le 08/06/2009 ;; http://www.cadxp.com/modules.php?op=modload&name=XForum&file=viewthread&tid=24151#pid103835 ;(defun c:pente% (/ p1 p2 a) (defun c:pentepc (/ p1 p2 a) (if (and (setq p1 (getpoint "\nPremier point: ")) (setq p2 (getpoint "\nDeuxieme point: ")) (setq a (angle p1 p2)) ) (entmake (list '(0 . "TEXT") '(100 . "AcDbEntity") '(100 . "AcDbText") '(10 0. 0. 0.) (cons 40 (getvar 'textsize)) (cons 1 (strcat (rtos (abs (* 100 (/ (sin a) (cos a)))) 2 2) " %") ) (cons 50 (if (minusp (cos a)) (+ pi a) a ) ) '(72 . 1) (cons 11 (mapcar '(lambda (x1 x2) (/ (+ x1 x2) 2.)) p1 p2)) '(73 . 1) ) ) ) (princ) )

Hello 1) Je sentais bien que la routine "ONESTYLE" de Gilles etait OK !? Mais je n avais pas AutoCAD "sous la main" pour tester ! 2) La fonction (JTB_ChangeTextStyleName "ISOCPEUR") de JTB ne traite que les TEXTs et MTEXTs du DWG DONC elle ne traite pas les Blocs ! 3) SVP sur quelle version de AutoCAD tu as fait tourner "ONESTYLE" ? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello 1) Je sentais bien que la routine "ONESTYLE" de Gilles etait OK !? Mais je n avais pas AutoCAD "sous la main" pour tester ! 2) La fonction (JTB_ChangeTextStyleName "ISOCPEUR") de JTB ne traite que les TEXTs et MTEXTs du DWG DONC elle ne traite pas les Blocs ! 3) SVP sur quelle version de AutoCAD tu as fait tourner "ONESTYLE" ? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello SVP tu regardes le Lisp que j ai fourni ICI : https://cadxp.com/topic/48842-supprimer-style-de-texte/ Mon message de 15h56 ! ... La routine de Gille , c "ONESTYLE" ! Tu fais un copier / coller dans le NOTEPAD.exe Enregistrer sous / ONESTYLE.lsp Chargement par APPLOAD dans AutoCAD et execution par la commande clavier : ONESTYLE Peut etre que la routine "ONESTYLE" de Gilles (GC) "attaque" les Blocs et Sous-Blocs !? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello 1) SVP tu vas essayer ces 2 routines Lisp jointes (tirees de mon stock de qq milliers de routines) que je n ai pas testees !? 2) SVP tu nous diras ce qu il en ait pour toi ? 3) Et aussi sur quelle version de AutoCAD tu les as fait tourner ? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite ;;; ;;; Routine : OneStyle par GC ;;; ;;; Attribue le style de texte sélectionne a tous les objets "texte" ;;; -------- Purge les autres styles ;;; ;;; Please BE Careful ! ;;; (defun c:OneStyle (/ TextStyles styles style ObjName) (vl-load-com) (or *acdoc* (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object))) ) (setq TextStyles (vla-get-TextStyles *acdoc*)) (vlax-for s TextStyles (setq styles (cons (vla-get-Name s) styles)) ) (setq styles (acad_strlsort (vl-remove "" styles))) (if (setq style (listbox "Choisir le style de texte" nil (mapcar '(lambda (x) (cons x x)) styles) 1 ) ) (progn (vlax-for b (vla-get-Blocks *acdoc*) (vlax-for e b (setq ObjName (vla-get-ObjectName e)) (cond ((member ObjName '("AcDbAttributeDefinition" "AcDbText" "AcDbMText" ) ) (vla-put-StyleName e style) (vla-update e) ) ((= (vla-get-ObjectName e) "AcDbBlockReference") (foreach a (vlax-invoke e 'GetAttributes) (vla-put-StyleName a style) ) ) ) ) ) (SetTextStyleToDimStyles style) (SetTextStyleToTableStyles style) (vla-put-ActiveTextStyle *acdoc* (vla-item TextStyles style)) (vla-put-ActiveDimStyle *acdoc* (vla-get-ActiveDimStyle *acdoc*)) (vlax-for ts TextStyles (or (= (vla-get-Name ts) style) (vl-catch-all-apply 'vla-delete (list ts)) ) ) (vla-regen *acdoc* acAllViewports) ) ) (princ) ) ;; ListBox par GC ;; 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" (layoutlist) 1) (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\";") (T "spacer;:list_box{key=\"lst\";multiple_select=true;") ) file ) (write-line "}spacer;ok_cancel;}" 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 ) ;;; SetTextStyleToDimStyles (gile) ;;; Attribue le style de texte a tous les styles de cote (defun SetTextStyleToDimStyles (ts / ds) (setq ts (tblobjname "style" ts)) (while (setq ds (tblnext "DIMSTYLE" (not ds))) (setq ds (entget (tblobjname "DIMSTYLE" (cdr (assoc 2 ds))))) (entmod (subst (cons 340 ts) (assoc 340 ds) ds ) ) ) ) ;;; SetTextStyleToTableStyles (gile) ;;; Attribue le style de texte à tous les styles de tableaux (defun SetTextStyleToTableStyles (ts) (vlax-for styl (vla-item (vla-get-Dictionaries *acdoc*) "ACAD_TABLESTYLE") (vla-setTextStyle styl 7 ts) ) ) ;;; ;;; https://jtbworld.com/autolisp-visual-lisp ;;; ;;; Change all text styles on all objects to specified text style ;;; ;;; ---- Lancement : (JTB_ChangeTextStyleName "ISOCPEUR") ;;; ;;; Please BE Careful ! ;;; (defun JTB_ChangeTextStyleName (style / sset ename i) (vl-load-com) (setq i 0) (setq sset (ssget "X" '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (-4 . "OR>")))) ;; ALL the DWG ; (setq sset (ssget '((-4 . "<OR") (0 . "MTEXT") (0 . "TEXT") (-4 . "OR>")))) ;; Classic Selection (if sset (repeat (sslength sset) (setq ename (ssname sset i)) (setq i (1+ i)) (vla-put-stylename (vlax-ename->vla-object ename) style) ) ) (setq sset nil) )

Hello En fait veux tu avoir TOUS Tes TEXTs et MTEXTs a l interieur de tes Blocs et Sous-Blocs avec UN SEUL et UNIQUE Style "STYLE_BLOC" par exemple !? SVP tu regardes CE sujet ... Et les 2 routines Lisp ... https://cadxp.com/topic/48842-supprimer-style-de-texte/page__gopid__295625#entry295625 Peut etre que la routine de Gilles (GC) "attaque" les Blocs et Sous-Blocs !? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello 1) Pas sur de bien te suivre ! 2) Tu as des TEXTs avec un Style particulier "DANGER" ! Facile de les trouver avec la selection rapide et donc de leur affecter un autre Style "TVB" par exemple Et idem pour les MTEXTs ... Mais bon on peux changer de TTF/SHX dans un MTEXT "partout" ! 3) Et pour tes MTEXTs ??? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello OK Merci ! En fait Eric avait fait un Couper / Coller du Update AutoCAD LT 2021.1 !? LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello 1) Le Stephanois est decu par le Lyonnais ! 2) La reponse est dans mon message !! LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello Perso: ma version preferee est la 2019 ! ... Sinon c la 2017/2016 voire 2012 ! Car dans AutoCAD 2019 , j aime bien le nouveau COMPARER 2D Graphique de 2 DWGs ! Et dans MAP 2019 (Je n utilise pas AutoCAD) , j adore le MAPIMPORT / MAPEXPORT KML pour Google Earth !! LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite

Hello https://cad.kerlom.fr/COVADIS.php - Qq trucs fort interessants sur ce site ! Ainsi vous saurez sur quel AutoCAD / ACAD MAP / ACAD Archi / ACAD Civil / etc, peut tourner un Covadis ! ET donc Covadis (AutoPiste / GeoRail) v17.1x exige un AutoCAD version 2018 minimum ! https://www.geo-media.com/solutions/georail-powered-covadis LA SANTE (Stay Safe), Bye, lecrabe "triste" Automne 2020, la retraite