Jump to content

Recommended Posts

Posted
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

  • Replies 47
  • Created
  • Last Reply

Top Posters In This Topic

  • CadFrank

    23

  • Tharwat

    12

  • BlackBox

    5

  • hanhphuc

    4

Posted
you are welcome. we help each other :)

 

Sure when I can help I will.

 

Cheers !

Posted

You should be able to use:

 

(vl-directory-files (getvar 'dwgprefix) "*LU-14094*.dwg" 1)

Posted

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

Posted

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

Posted (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 by CadFrank
Posted
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 :D

Posted
If it's possible i'd only like to be pointed in the right direction :D

 

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> )

Posted
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 !!

Posted

Upload a sample drawing of what you are working on to allow me to test it out for you .

Posted

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.

Posted

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 .

Posted

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.

Posted
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 .

Posted

Ok give me a second the the current drawing I though I changed all the tag string !

Posted

Somehow I can't upload more file :S

Posted
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

Posted

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 :)

Posted
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

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...