zara

Bonjour Christian, Merci pour cette réponse en effet ça pourrait être la solution. Où et comment rajouter une ligne qui permettrai l'ouverture de chaque bloc dans l'éditeur de blocs / un zoom étendue / la fermeture / l'enregistrement. ;; Redefine All Blocks - Lee Mac (defun c:redefall ( / bln dir doc dwg lst obj org spc ) (setq dir "D:\\_DOSSIER ACTIF\\") ;; Directory of Block Library; nil to use Support Path (if dir (setq dir (strcat (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir)) "\\")) (setq dir "") ) (cond ( (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer)))))) (princ "\nCurrent layer locked.") ) ( (setq doc (vla-get-activedocument (vlax-get-acad-object)) spc (vla-get-modelspace doc) org (vlax-3D-point 0 0) ) (terpri) (vlax-for blk (vla-get-blocks doc) (if (and (= :vlax-false (vla-get-isxref blk)) (= :vlax-false (vla-get-islayout blk)) (not (wcmatch (setq bln (vla-get-name blk)) "`**,*|*")) ) (if (setq dwg (findfile (strcat dir bln ".dwg"))) (progn (princ (strcat "Redefining block: " dwg "\n")) (setq obj (vla-insertblock spc org dwg 1.0 1.0 1.0 0.0)) (if (= :vlax-true (vla-get-hasattributes obj)) (setq lst (vl-list* "," bln lst)) ) (vla-delete obj) ) (princ (strcat "Unable to locate block: " dir bln ".dwg\n")) ) ) ) (if lst (progn (princ "Synchronising attributes for redefined blocks...\n") (vl-cmdf "_.attsync" "_N" (apply 'strcat (cdr lst))) ) ) (textscr) (vla-regen doc acallviewports) ) ) (princ) ) (vl-load-com) (princ) Merci par avance Simon

Bonjour, Après l'utilisation d'un lisp pour la redéfinition des blocs du dessin à partir d'un dossier contenant tous les blocs références. J'ai un souci avec les blocs dynamiques.Ces derniers ne se synchronisent pas avec l’éditeur de bloc car un paramètre a été utilisé. Mais quand je rentre dans l’éditeur je fais un zoom étendu et que j'enregistre tout se replace bien. Ça fonctionne bien aussi avec design center en faisant redéfinir mais trop long de faire bloc par bloc. Y aurait il un moyen de synchroniser les blocs comme attsync? https://uptobox.com/n3r2qv3wtipz Merci par avance.

Merci pour la piste. Mais déja testé. Ne fonctionne pas sous ZWCAD. "erreur argument nil" quelque chose comme ca. Dommage.

Bonjour, Merci beaucoup ca fonctionne trés bien. En effet quand je rechange la police en appliquant un nouveau style et relance le lisp visuellement pas de changement mais en fermant et réouvrant le fichier c'est ok. Je souhaité le combiner à ce lisp venant de CADXP (Gile) pour formater la police pour quelle prenne le style du texte sans passer par l'éditeur. Mais je souhaiterai que ça n'affecte que la police et pas la justification. Pensez vous cela possible? (defun c:c_txt (/ ss n txt e_lst str start end lst) (while (not (setq ss (ssget '((0 . "MTEXT")))))) (repeat (setq n (sslength ss)) (setq txt (ssname ss (setq n (1- n))) e_lst (entget txt) str (apply 'strcat (mapcar 'cdr (append (vl-remove-if-not '(lambda (x) (= (car x) 3)) e_lst) (list (assoc 1 e_lst)) ) ) ) ) (while (setq start (vl-string-search "{\\" str)) (setq str (vl-string-subst "" "{" (vl-string-subst "" "}" str start) start ) ) ) (setq start 0) (while (setq start (vl-string-search "\\" str start)) (cond ((= "\\P" (substr str (1+ start) 2)) (setq start (1+ start) end (1+ start) ) ) ((= "\\L" (substr str (1+ start) 2)) (setq end (+ (vl-string-search "L" str start) 2)) ) ((= "\\l" (substr str (1+ start) 2)) (setq end (+ (vl-string-search "l" str start) 2)) ) (T (setq end (+ (vl-string-search ";" str start) 2))) ) (setq str (vl-string-subst "" (substr str (1+ start) (- end start 1)) str ) ) ) (setq lst nil) (if (< 250 (strlen str)) (progn (while (< 249 (strlen str)) (setq lst (cons (cons 3 (substr str 1 250)) lst) str (substr str 251) ) ) (setq lst (reverse (cons (cons 1 str) lst))) ) (setq lst (cons (cons 1 str) lst)) ) (setq e_lst (append (vl-remove-if '(lambda (x) (or (= (car x) 3) (= (car x) 1))) e_lst ) lst ) ) (entmod e_lst) ) (princ) ) Merci encore Cordialement Zara

http://nsa37.casimages.com/img/2017/07/18/170718050659997994.jpg A croire qu'il crée une nouvelle référence...

Merci pour vos réponses. ;) Quand je laisse ARIAL dans le lisp. ZWCAD http://nsa38.casimages.com/img/2017/07/18/17071804461075120.png AUTOCAD http://nsa38.casimages.com/img/2017/07/18/170718044610482331.png En remplacant par ARIAL.TTF ou (C:/windows/fonts/arial.ttf) http://nsa38.casimages.com/img/2017/07/18/170718044610167193.png Autocad ne reconnait pas le arial normal... Merci pour la demande à zwsoft. Cordialement Zara

Bonjour, Je travail sur ZwCAD. J'ai trouvé un lisp sur cadxp (bryce) qui fonctionne très bien pour le changement de style de texte. Il me passe tout en ARIAL. Police Nom: ARIAL -->ok Style: Normal -->ok Langage: 1(introuvable) -->pas ok :angry: Du coup autocad ne me reconnais pas la police. Il y a t-il un moyen de forcer le langage en Occidental? Merci par avance. Zara (defun c:font ( / st acdoc) (vl-load-com) (setq acdoc (vla-get-activedocument (vlax-get-acad-object)) st (vla-get-TextStyles acdoc) ) (vlax-for s st (vla-put-FontFile s "Arial") (vla-put-Height s 0.0) (vla-put-Width s 1) ) (vla-regen acdoc 0) )

Bonjour Olivier, C'est parfait ça fonctionne impeccable. :D Merci beaucoup bonne journée Zara

Hello, Merci beaucoup le crabe pour cette réponse. Mais ton lisp ne transforme que les entités à l’intérieur des blocs et mon souhait serai de passer toutes les entités sauf "l'intérieur" des blocs (j'ai déjà un lisp qui les passe en dubloc) et les hachures. Tout en ducalque sauf "l’intérieur" des blocs et les hachures. Je ne sait pas si je suis clair... Merci encore pour ta réponse Bye Zara

Bonjour, Après plusieurs essais infructueux je n'arrive pas à modifier ce code. Objectif tout mettre dans la couleur ducalque sauf les hachures. Je ne sait pas ou placer cette ligne" (if (/= (vla-get-ObjectName subent) "AcDbHatch")" Cela doit demander une bonne connaissance du langage lisp que je n'ai pas... Merci par avance pour votre aide. Cordialement Zara (defun c:test (/ doc ods) (setq doc (vla-get-activedocument (vlax-get-acad-object))) ;;fix all dimstyles (setq ods (getvar "dimstyle")) (vlax-for d (vla-get-dimstyles doc) (vla-put-activedimstyle doc d) (foreach n '("dimclrt" "dimclrd" "dimclre") (setvar n 256) ) (vla-copyfrom d doc) ) ;;need more code to fix mleader styles, and table styles. Consider stripmtext by others. ;......... ;;fix all objects (does not include mtext color encoding) (vlax-for b (vla-get-blocks doc) (if (= (vla-get-isxref B) :vlax-false) (vlax-for n b (if (wcmatch (vla-get-objectname n) "*Dim*") (vla-put-stylename n (vla-get-stylename n)) (vl-catch-all-apply 'vla-put-color (list n 256)) )))) (setvar "dimstyle" ods) (vla-regen doc acallviewports) )

Bonjour, Je m'excuse d’insister après plusieurs essais infructueux je n'arrive pas à faire la même chose sur ce code. Objectif tout mettre dans la couleur ducalque sauf les hachures. Je ne sait pas ou placer cette ligne" (if (/= (vla-get-ObjectName subent) "AcDbHatch")" Cela doit demander une bonne connaissance du langage lisp que je n'ai pas... (defun c:test (/ doc ods) (setq doc (vla-get-activedocument (vlax-get-acad-object))) ;;fix all dimstyles (setq ods (getvar "dimstyle")) (vlax-for d (vla-get-dimstyles doc) (vla-put-activedimstyle doc d) (foreach n '("dimclrt" "dimclrd" "dimclre") (setvar n 256) ) (vla-copyfrom d doc) ) ;;need more code to fix mleader styles, and table styles. Consider stripmtext by others. ;......... ;;fix all objects (does not include mtext color encoding) (vlax-for b (vla-get-blocks doc) (if (= (vla-get-isxref B) :vlax-false) (vlax-for n b (if (wcmatch (vla-get-objectname n) "*Dim*") (vla-put-stylename n (vla-get-stylename n)) (vl-catch-all-apply 'vla-put-color (list n 256)) )))) (setvar "dimstyle" ods) (vla-regen doc acallviewports) ) Merci Zara

Bonjour, Merci beaucoup pour cette réponse cela fonctionne parfaitement. :D J'en profite d'avoir Patrick de ZWCAD sous la main pour lui demander si il serai possible pour l'achat de deux licenses de réaliser une demande spécifique. Je souhaiterai utiliser de manière intensive le convertisseur de calque dans Norme CAO. Hélas la fenêtre ne peux s’agrandir comme sur autocad... Pensez vous que cela serai possible? Merci encore pour le lisp. Bien cordialement Zara

Bonjour, Je suis sur ZWCAD les lisp fonctionnent plutôt bien mise à part une qui me serai très utile: Region2Polyline by Gile. Elle se lance bien me filtre bien les regions mais rien de plus les régions restent des regions... Pensez vous qu'il est possible de selectionner les regions et de les décomposer par la suite en modifiant le code. Je suis vraiment pas au point pour déchiffrer et modifier un tel code... :blink: Merci par avance pour la réponse Zara (defun c:Region2Polyline nil (if (setq ss (ssget '((0 . "REGION")))) (:Region2Polyline ss)) (princ) ) ;; Gilles Chanteau- 01/01/07 (defun :Region2Polyline (ss / *error* arcbugle acdoc space n reg norm expl olst blst dlst plst tlst blg pline) ;----- (defun *error* (msg) (if (/= msg "Function cancelled") (princ (strcat "\nError: " msg))) (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object))) (princ)) ;----- (defun arcbulge (arc) (/ (sin (/ (vla-get-TotalAngle arc) 4)) (cos (/ (vla-get-TotalAngle arc) 4)))) ;----- ;----- (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object)) space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace acdoc) (vla-get-ModelSpace acdoc))) (if ss (repeat (setq i (sslength ss)) (setq reg (vlax-ename->vla-object (ssname ss (setq i (1- i)))) norm (vlax-get reg 'Normal) expl (vlax-invoke reg 'Explode)) (if (vl-every '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine") (= (vla-get-ObjectName x) "AcDbArc"))) expl) (progn (vla-delete reg) (setq olst (mapcar '(lambda (x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint))) expl)) (while olst (setq blst nil) (if (= (vla-get-ObjectName (caar olst)) "AcDbArc") (setq blst (list (cons 0 (arcbulge (caar olst)))))) (setq plst (cdar olst) dlst (list (caar olst)) olst (cdr olst)) (while (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9) (equal (last plst) (caddr x) 1e-9))) olst)) (if (equal (last plst) (caddar tlst) 1e-9) (setq blg -1) (setq blg 1)) (if (= (vla-get-ObjectName (caar tlst)) "AcDbArc") (setq blst (cons (cons (1- (length plst)) (* blg (arcbulge (caar tlst))) ) blst))) (setq plst (append plst (if (minusp blg) (list (cadar tlst)) (list (caddar tlst)))) dlst (cons (caar tlst) dlst) olst (vl-remove (car tlst) olst))) (setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x) (setq x (trans x 0 Norm)) (list (car x) (cadr x))) (reverse (cdr (reverse plst))))))) (vla-put-Closed pline :vlax-true) (mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst) (vla-put-Elevation pline (caddr (trans (car plst) 0 Norm))) (vla-put-Normal pline (vlax-3d-point Norm)) (mapcar 'vla-delete dlst))) (mapcar 'vla-delete expl))) ) )

C'est parfait!!!! :D Merci à vous deux. Très bon week-end!!!!

Salut, Merci pour cette réponse. C'est un honneur pour moi de converser avec "le boss" gile. J'ai remplacer la fin comme indiqué mais le lisp ne se lance plus du tout. :mellow: Aurais je oublié quelque chose? merci encore (defun c:xcv (/ *error* adoc lst_layer func_restore-layers) (defun *error* (msg) (func_restore-layers) (vla-endundomark adoc) (princ msg) (princ) ) ;_ end of defun (defun func_restore-layers () (foreach item lst_layer (vla-put-lock (car item) (cdr (assoc "lock" (cdr item)))) (vl-catch-all-apply '(lambda () (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item)))) ) ;_ end of lambda ) ;_ end of vl-catch-all-apply ) ;_ end of foreach ) ;_ end of defun (vl-load-com) (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))) ) ;_ end of vla-startundomark (vlax-for item (vla-get-layers adoc) (setq lst_layer (cons (list item (cons "lock" (vla-get-lock item)) (cons "freeze" (vla-get-freeze item)) ) ;_ end of list lst_layer ) ;_ end of cons ) ;_ end of setq (vla-put-lock item :vlax-false) (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false))) ) ;_ end of vlax-for (vlax-for blk (vla-get-blocks adoc) (if (and (equal (vla-get-islayout blk) :vlax-false) (equal (vla-get-isxref blk) :vlax-false) ) ;_ end of and (progn (vlax-for subent blk (if (/= (vla-get-ObjectName subent) "AcDbHatch") (progn (vla-put-layer subent "0") (vla-put-color subent 0) (vla-put-lineweight subent aclnwtbyblock) (vla-put-linetype subent "byblock") );_ end of progn );_ end of if ) ;_ end of vlax-for ) ;_ end of progn