CadFrank Posted August 12, 2014 Author Posted August 12, 2014 maybe? (setq l (vl-remove-if[color="red"]-not[/color] '(lambda (ex) (wcmatch ex "*LU-14094*")) f)) Omg!! that function existed... Seriously I must of been blind. Thanks alot Quote
CadFrank Posted August 12, 2014 Author Posted August 12, 2014 you are welcome. we help each other Sure when I can help I will. Cheers ! Quote
Lee Mac Posted August 12, 2014 Posted August 12, 2014 You should be able to use: (vl-directory-files (getvar 'dwgprefix) "*LU-14094*.dwg" 1) Quote
CadFrank Posted August 13, 2014 Author Posted August 13, 2014 Well I'm back with another question !!! (vlax-for lt (vla-get-layouts adoc) ;(vla-put-activelayout adoc lt) ; optionnel (vlax-for obj (vla-get-block lt) (if (and (= "AcDbBlockReference" (vla-get-objectname obj)) (member (vla-get-effectivename obj) Nombloc) (= :vlax-true (vla-get-hasattributes obj) )) (progn (setq atts (vlax-invoke obj 'getattributes)) (foreach x atts (if (= TagRev (vla-get-tagstring x)) ;<---- the if is what changes all the time. (vla-put-textstring x TRev) ) ) ) ) ) ) So I've been using this code alot in my code. Is there a way to make it shorter so I don't repeat it all the time. Like a smaller program that I call Quote
BlackBox Posted August 13, 2014 Posted August 13, 2014 So I've been using this code alot in my code. Is there a way to make it shorter so I don't repeat it all the time. Like a smaller program that I call Make it a sub-function; create a new DEFUN and call that sub-function supplying the Document parameter within your code instead of duplicating same. Cheers Quote
CadFrank Posted August 13, 2014 Author Posted August 13, 2014 (edited) Well thats what I don't understand ! don't know how to make my sub functions to work! Don't understand the arguments in the brackets ! So thats where i need help Thanks Edited August 14, 2014 by CadFrank Quote
CadFrank Posted August 14, 2014 Author Posted August 14, 2014 Well thats what I don't understand ! don't know how to make my sub functions to work! Don't understand the arguments in the brackets ! So thats where i need help Thanks If it's possible i'd only like to be pointed in the right direction Quote
Tharwat Posted August 14, 2014 Posted August 14, 2014 If it's possible i'd only like to be pointed in the right direction With respect to what BlackBox suggested and I hope that he would not mind if I translated his idea to reality for you Frank , so here it goes . (defun change-attribute-textstring (adoc TagRev Nomblo) (vlax-for lt (vla-get-layouts adoc) (vlax-for obj (vla-get-block lt) (if (and (= "AcDbBlockReference" (vla-get-objectname obj)) (member (vla-get-effectivename obj) Nombloc) (= :vlax-true (vla-get-hasattributes obj)) ) (foreach x (vlax-invoke obj 'getattributes) (if (= TagRev (vla-get-tagstring x)) (vla-put-textstring x TRev) ) ) ) ) ) ) Usage of the above function : (change-attribute-textstring (vla-get-activedocument (vlax-get-acad-object)) <text_string> <list_Block_names> ) Quote
CadFrank Posted August 14, 2014 Author Posted August 14, 2014 With respect to what BlackBox suggested and I hope that he would not mind if I translated his idea to reality for you Frank , so here it goes . (defun change-attribute-textstring (adoc TagRev Nomblo) (vlax-for lt (vla-get-layouts adoc) (vlax-for obj (vla-get-block lt) (if (and (= "AcDbBlockReference" (vla-get-objectname obj)) (member (vla-get-effectivename obj) Nombloc) (= :vlax-true (vla-get-hasattributes obj)) ) (foreach x (vlax-invoke obj 'getattributes) (if (= TagRev (vla-get-tagstring x)) (vla-put-textstring x TRev) ) ) ) ) ) ) Usage of the above function : (change-attribute-textstring (vla-get-activedocument (vlax-get-acad-object)) <text_string> <list_Block_names> ) Well I tried what you wrote down but I think you might of been missing another part of the code. When I test your code it end up doing nil at the end but does not modify the text of the attribut. So here's what I do (defun _Modification (/ obj atts x lt Nombloc) (setq Nombloc '("LU CARTOUCHE" "Cartouche Aliance" "LC CARTOUCHE CHUM" "LC CARTOUCHE CHUM 2" "LC CARTOUCHE" "LU CARTOUCHE PANNEAU" "CARTOUCHE LU" "LC CARTOUCHE 2" ) ) (initget 1 "P T D V") (setq Mod (getkword "\n Quel élément voulez vous modifier? [Projet/Titre/Date/Verificateur] : ")) (if (= Mod "P") (progn (setq TProjet (strcase (getstring T "\n Quel est le nouveau nom du projet? "))) (setq TagPro "PROJET") (change-attribute-textstring (vla-get-activedocument (vlax-get-acad-object)) TProjet Nombloc) ) ) ) Now the sub-function (defun change-attribute-textstring (adoc Tag Nombloc) (vlax-for lt (vla-get-layouts adoc) (vlax-for obj (vla-get-block lt) (if (and (= "AcDbBlockReference" (vla-get-objectname obj)) (member (vla-get-effectivename obj) Nombloc) (= :vlax-true (vla-get-hasattributes obj)) ) (foreach x (vlax-invoke obj 'getattributes) (if (= Tag (vla-get-tagstring x)) (vla-put-textstring x Text) ) ) ) ) ) ) So here it is !! Quote
Tharwat Posted August 14, 2014 Posted August 14, 2014 Upload a sample drawing of what you are working on to allow me to test it out for you . Quote
CadFrank Posted August 14, 2014 Author Posted August 14, 2014 Test.dwg There we go ! The attributes I want to change are all in the Layouts and I want to change all at the same time. Quote
Tharwat Posted August 14, 2014 Posted August 14, 2014 The names of the two blocks in each layout is not included in the list of block names in your codes , so the function could not find them to make any change . Quote
CadFrank Posted August 14, 2014 Author Posted August 14, 2014 Technicaly the only block I want to change some attributes is "CARTOUCHE LU" but in the future I might have more different names but with the same attributs. Quote
Tharwat Posted August 14, 2014 Posted August 14, 2014 Technicaly the only block I want to change some attributes is "CARTOUCHE LU" but in the future I might have more different names but with the same attributs. We are talking about current time , and I asked you to upload a sample drawing and you uploaded a drawing with different story . Up to you . The tag string is case sensitive so when you lower the string from the routine you should also lower the tag string in the sub-function that I wrote before . Quote
CadFrank Posted August 14, 2014 Author Posted August 14, 2014 Ok give me a second the the current drawing I though I changed all the tag string ! Quote
CadFrank Posted August 14, 2014 Author Posted August 14, 2014 Somehow I can't upload more file :S Quote
CadFrank Posted August 14, 2014 Author Posted August 14, 2014 We are talking about current time , and I asked you to upload a sample drawing and you uploaded a drawing with different story . Up to you . Ok go it! Test2.dwg Quote
CadFrank Posted August 14, 2014 Author Posted August 14, 2014 Might help you more if i posted the full code also ! ;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦; ;¦¦¦ CE PROGRAM EST CONÇU POUR REMPLIR LES CARTOUCHES ¦¦¦; ;¦¦¦ _______________________________________________________________________ ¦¦¦; ;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦; ;¦¦¦ AUTEUR : François Lévesque CadFrank, Copyright ® 2014 ¦¦¦; ;¦¦¦ _______________________________________________________________________ ¦¦¦; ;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦; ;¦¦¦ Ce sous-program construit une liste à partir du chemin du dessin actuel ¦¦¦; ;¦¦¦ _______________________________________________________________________ ¦¦¦; (defun _FilePath->List (filePath / i folder folders) (setq filePath (vl-string-translate "\\" "/" filePath)) (while (setq i (vl-string-search "/" filePath)) (setq folders (cons (setq folder (substr filePath 1 i)) folders)) (setq filePath (substr filePath (+ 2 i))) ) (reverse folders) );fin _FilePath->List ;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦; ;¦¦¦ Ce sous-program done la date ¦¦¦; ;¦¦¦ _______________________________________________________________________ ¦¦¦; (defun _Today ( / d yr mo day) (setq d (rtos (getvar "CDATE") 2 6) yr (substr d 1 4) mo (substr d 5 2) day (substr d 7 2) );setq (strcat day "-" mo "-" yr) );fin TODAY ;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦; ;¦¦¦ Sous-program pour un début de projet ¦¦¦; ;¦¦¦ _______________________________________________________________________ ¦¦¦; (defun _NouvProjet (/ lt obj atts x id lay_field TagPag Tag#Pg Tnumtabs TagPro TProjet TagTit TTitre TagNPr TNProjet TagNPl TNPlan TagDes TagVer Tnumtabs TProjet TTitre TNProjet TNPlan Tdes Tver) ;| Élénment de text |; (setq Tnumtabs (itoa (length (layoutlist))) TProjet (strcase (getstring T "\n Quel est le nom du projet: ")) TTitre (strcase (getstring T "\n Inscrire le titre : ")) TNProjet (substr (nth 5 (_FilePath->LIST (getvar 'dwgprefix))) 1 8 ) l (length (vl-remove-if-not '(lambda (ex) (wcmatch ex (strcat "*" TNProjet "*"))) (vl-directory-files (getvar 'dwgprefix) ".dwg" 1) ) ) TNPlan (strcat TNProjet "-0" (itoa l)) ) (initget 1 "C F J S") (setq Tdes (getkword "\n Qui a dessiné le plan [Charle/François/Julieta/Simon]: ")) (if (= Tdes "C")(setq Tdes "CHARLES LATENDRESSE, Tech")) (if (= Tdes "F")(Setq Tdes "FRANÇOIS LÉVESQUE, Tech")) (if (= Tdes "J")(setq Tdes "JULIETA LJUBICH, Ing")) (if (= Tdes "S")(setq Tdes "SIMON DROLET, Ing")) (initget 1 "J S") (setq Tver (getkword "\n Qui est l'ingénieur du projet [Julieta/Simon]: ")) (if (= Tver "J")(setq Tver "JULIETA LJUBICH, Ing")) (if (= Tver "S")(setq Tver "SIMON DROLET, Ing")) ;| Élénment des TAG |; (setq TagPag "PAGE" ; étiquette de l'attribut numéro de page Tag#Pg "#PAGE" ; étiquette de l'attribut nombre de pages TagPro "PROJET" ; étiquette de l'attribut Projet TagTit "TITRE" ; étiquette de l'attribut Titre TagNPr "N°PROJET" ; étiquette de l'attribut Numero de N° Projet TagNpl "N°PLAN" ; étiquette de l'attribut Numero de N° PLAN TagDes "DESSINE" ; étiquette de l'attribut Nom du dessinateur TagVer "VERIFIE" ; étiquette de l'attribut Nom du vérificateur ) (vlax-for lt (vla-get-layouts adoc) ;(vla-put-activelayout adoc lt) ; optionnel (vlax-for obj (vla-get-block lt) (if (and (= "AcDbBlockReference" (vla-get-objectname obj)) (member (vla-get-effectivename obj) Nombloc) (= :vlax-true (vla-get-hasattributes obj) )) (progn (setq atts (vlax-invoke obj 'getattributes)) (foreach x atts (if (= TagPag (vla-get-tagstring x)) (progn (setq id (vla-get-objectid (vla-get-layout (vla-objectidtoobject adoc (vla-get-ownerid obj))))) (setq lay_field (strcat "%<\\AcObjProp Object(%<\\_ObjId " (itoa id)">%).Taborder \\f \"%tc1\">%")) (vla-put-textstring x lay_field) ) ) (if (= Tag#Pg (vla-get-tagstring x)) (vla-put-textstring x Tnumtabs) ) (if (= TagPro (vla-get-tagstring x)) (vla-put-textstring x TProjet) ) (if (= TagTit (vla-get-tagstring x)) (vla-put-textstring x TTitre) ) (if (= TagNPr (vla-get-tagstring x)) (vla-put-textstring x TNProjet) ) (if (= TagNPl (vla-get-tagstring x)) (vla-put-textstring x TNPlan) ) (if (= TagDes (vla-get-tagstring x)) (vla-put-textstring x TDes) ) (if (= TagVer (vla-get-tagstring x)) (vla-put-textstring x Tver) ) ) ) ) ) ) (_Revision) (vla-put-activelayout adoc (vla-item (vla-get-layouts adoc) 1)) ; activer Layout1, optionnel (princ) );fin NouvProjet ;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦; ;¦¦¦ Sous-program pour une révision du plan. ¦¦¦; ;¦¦¦ _______________________________________________________________________ ¦¦¦; (defun _Revision (/ TRev TDesc Tdate TPar TApp TagRev TagNRev TagDesc TagDat TagPar TagApp lt obj atts x DynBP) ;| Élénment de text |; (if (= choix "N") (setq TRev "0")) (if (= choix "R") (setq TRev (itoa (fix (getreal "\n Numéro de révision : "))))) (setq TDesc (strcase (getstring T "\n Donner la raison de la révision. : ")) Tdate (_Today) ) (initget 1 "C F J S") (setq TPar (getkword "\n Qui a fait les changements sur le plan? [Charle/François/Julieta/Simon]: ")) (if (= TPar "C")(setq TPar "C.L")) (if (= TPar "F")(Setq TPar "F.L")) (if (= TPar "J")(setq TPar "J.L")) (if (= TPar "S")(setq TPar "S.D")) (initget 1 "J S") (setq TApp (getkword "\n Qui a approuvé les changement [Julieta/Simon]: ")) (if (= TApp "J")(setq TApp "J.L")) (if (= TApp "S")(setq TApp "S.D")) ;| Élénment des TAG |; (setq TagRev "REV" TagNRev (strcat "N°REV" TRev) TagDesc (strcat "DESCRITION" TRev) TagDat (strcat "DATE" TRev) TagPar (strcat "PAR" TRev) TagApp (strcat "APP" TRev) ) ;Inscrit le texte dans chacun des attributs (vlax-for lt (vla-get-layouts adoc) (vlax-for obj (vla-get-block lt) (if (and (= "AcDbBlockReference" (vla-get-objectname obj)) (member (vla-get-effectivename obj) Nombloc) (= :vlax-true (vla-get-hasattributes obj) )) (progn (setq atts (vlax-invoke obj 'getattributes)) (foreach x atts (if (= TagRev (vla-get-tagstring x)) (vla-put-textstring x TRev) ) (if (= TagNRev (vla-get-tagstring x)) (vla-put-textstring x TRev) ) (if (= TagDesc (vla-get-tagstring x)) (vla-put-textstring x TDesc) ) (if (= TagDat (vla-get-tagstring x)) (vla-put-textstring x Tdate) ) (if (= TagPar (vla-get-tagstring x)) (vla-put-textstring x TPar) ) (if (= TagApp (vla-get-tagstring x)) (vla-put-textstring x TApp) ) (setq DynBP (nth 2 (vlax-invoke obj 'GetDynamicBlockProperties))) (vla-put-value DynBP TRev) ) ) ) ) ) ); fin _Revision ;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦; ;¦¦¦ Sous-program pour une modification des information du projet. ¦¦¦; ;¦¦¦ _______________________________________________________________________ ¦¦¦; (defun _Modification (/ obj atts x lt) (setq Nombloc '("LU CARTOUCHE" "Cartouche Aliance" "LC CARTOUCHE CHUM" "LC CARTOUCHE CHUM 2" "LC CARTOUCHE" "LU CARTOUCHE PANNEAU" "CARTOUCHE LU" "LC CARTOUCHE 2" ) ) (initget 1 "P T D V") (setq Mod (getkword "\n Quel élément voulez vous modifier? [Projet/Titre/Date/Verificateur] : ")) (if (= Mod "P") (progn (setq TProjet (strcase (getstring T "\n Quel est le nouveau nom du projet? "))) (setq TagPro "PROJET") (change-attribute-textstring (vla-get-activedocument (vlax-get-acad-object)) TProjet Nombloc) ) ) ) ;¦¦¦ ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ ¦¦¦; ;¦¦¦ Début du Programme ¦¦¦; ;¦¦¦ _______________________________________________________________________ ¦¦¦; (vl-load-com) (defun C:PG (/ choix adoc Nombloc) (setq adoc (vla-get-activedocument (vlax-get-acad-object))) (setq Nombloc '("LU CARTOUCHE" "Cartouche Aliance" "LC CARTOUCHE CHUM" "LC CARTOUCHE CHUM 2" "LC CARTOUCHE" "LU CARTOUCHE PANNEAU" "CARTOUCHE LU" "LC CARTOUCHE 2")) ; nom du bloc cartouche (initget 1 "M N R") (setq choix (getkword "\n Quelle étape voulez-vous entamer? [Modification/Nouveau/Révision] : ")) (if (= choix "M") (_Modification) ) (if (= choix "N") (_NouvProjet) ) (if (= choix "R") (_Revision) ) );fin defun c: (defun change-attribute-textstring (adoc Tag Nombloc) (vlax-for lt (vla-get-layouts adoc) (vlax-for obj (vla-get-block lt) (if (and (= "AcDbBlockReference" (vla-get-objectname obj)) (member (vla-get-effectivename obj) Nombloc) (= :vlax-true (vla-get-hasattributes obj)) ) (foreach x (vlax-invoke obj 'getattributes) (if (= Tag (vla-get-tagstring x)) (vla-put-textstring x Text) ) ) ) ) ) ) But it's not completed and I'm no expert here! So the code might now be well designed ! And i'm in a French country :S And BlackBox Doesn't know it but he help alot in it Quote
CadFrank Posted August 14, 2014 Author Posted August 14, 2014 The names of the two blocks in each layout is not included in the list of block names in your codes , so the function could not find them to make any change . Did you mean attributs here? Or else I'm not really following what your trying to tell me.. Sry Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.