transformer un bloc + text à un bloc avec attribut
#1
Posté 21 janvier 2021 - 11:01
J'aimerai savoir si il était possible de créer un code vba où pour sélectionner un des blocs puis un texte le plus proche de lui afin qu'il le convertisse en bloc/attribut,
en effet j'ai un fichier avec plusieurs blocs + texte et je veux automatiser la manipulation (j'ai presque 1000 bloc avec texte)
Merci pour votre aide.
#2
Posté 21 janvier 2021 - 16:19
Alors oui c'est possible !
par contre j'ai pas trop le temps en se moment...
C'est urgent ou pas trop ?
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)
Mon site Web (en cours de construction) : Site
#3
Posté 21 janvier 2021 - 21:42
Curlygoth, le 21 janvier 2021 - 16:19 , dit :
Alors oui c'est possible !
par contre j'ai pas trop le temps en se moment...
C'est urgent ou pas trop ?
Merci pour votre réponse,
Bah il me faut un rendu avant lundi.. j'ai essayé un lisp sur internet mais il prend n'importe quel texte qui est le plus proche.. donc je dois filtrer les textes après la sélection ( (par exemple les textes qui commence par ST* car tous les textes sont dans le même calque).
#4
Posté 22 janvier 2021 - 09:31
et comment ça n'importe quel texte le plus proche ?
le plus proche si tu n'as qu'un point des textes le plus proche il doit te prendre celui la après je suis pas lispeur.. Malheureusement...
si deux textes sont a la même distance du centre de ton bloc ou de ta forme...
tu peux m'envoyer ton fichier ?
je te promets rien par rapport au délai... mais je vais regarder
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)
Mon site Web (en cours de construction) : Site
#5
Posté 22 janvier 2021 - 09:45
Curlygoth, le 22 janvier 2021 - 09:31 , dit :
et comment ça n'importe quel texte le plus proche ?
le plus proche si tu n'as qu'un point des textes le plus proche il doit te prendre celui la après je suis pas lispeur.. Malheureusement...
si deux textes sont a la même distance du centre de ton bloc ou de ta forme...
tu peux m'envoyer ton fichier ?
je te promets rien par rapport au délai... mais je vais regarder
Merci pour votre réponse,
Dans le cas ou un bloc qui n'ayant pas un texte, il va impérativement prendre un texte ! donc au moins je vais ajouter une condition si le texte se trouve au moins d'une distance x il le transforme en attribut sinon pas la peine. Cette consition je ne sais pas fais avec le code lisp

Bonne journée
#6
Posté 22 janvier 2021 - 10:21
envoie ton fichier sinon je peux te lancer des pistes :
tu aura certainnement des erreurs mais par manque de temps je donne des pistes :
1°)
boucle sur tous les objets de dessin
2°) verifier si c'est un block ou non / ou txt ou non
3°) verifier la plus courte distance entre bloc et texte e si ca te va tu insrer l'attribut dans le block
sinon tu le rentre manuellement ou tu met rien...
le mode manuel ressemblerait à ça :
(j'ai pas tester !!!!!)
on goto err_ceci_pas_TXT Dim textObj As AcadText ' ou Mtext ! ThisDrawing.Utility.GetEntity text, basePnt, "Sélectionner le texte" text = textObj.textString on error goto 0 on goto err_ceci_pas_BLOCK Dim blockRefObj As AcadBlockReference ThisDrawing.Utility.GetEntity blockRefObj, basePnt, "Sélectionner le block" on error goto 0 'ajouter l'attribut Dim attributeObj As AcadAttribute Dim H_TXT As Double Dim mode As Long Dim ETIQUETTE As String Dim insertionPoint(0 To 2) As Double Dim TAG As String Dim VALEUR As String height = 1# mode = acAttributeModeVerify ETIQUETTE = "Attribute Prompt" insertionPoint(0) = 1#: insertionPoint(1) = 1#: insertionPoint(2) = 0 'je ne sais pas ou doivent etre ton attribut par rapport à ton bloc TAG = Attribut 'creation de l'attribut dans le block Set attributeObj = blockObj.AddAttribute(H_TXT, mode, ETIQUETTE, insertionPoint, TAG, text)
je ne l'ai pas tester je l'ai écrit vite fait dans ton attribut suivant ton style de texte tu risques d'avoir des caracteres spéciaux !
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)
Mon site Web (en cours de construction) : Site
#7
Posté 22 janvier 2021 - 11:06
Curlygoth, le 22 janvier 2021 - 10:21 , dit :
envoie ton fichier sinon je peux te lancer des pistes :
tu aura certainnement des erreurs mais par manque de temps je donne des pistes :
1°)
boucle sur tous les objets de dessin
2°) verifier si c'est un block ou non / ou txt ou non
3°) verifier la plus courte distance entre bloc et texte e si ca te va tu insrer l'attribut dans le block
sinon tu le rentre manuellement ou tu met rien...
le mode manuel ressemblerait à ça :
(j'ai pas tester !!!!!)
on goto err_ceci_pas_TXT Dim textObj As AcadText ' ou Mtext ! ThisDrawing.Utility.GetEntity text, basePnt, "Sélectionner le texte" text = textObj.textString on error goto 0 on goto err_ceci_pas_BLOCK Dim blockRefObj As AcadBlockReference ThisDrawing.Utility.GetEntity blockRefObj, basePnt, "Sélectionner le block" on error goto 0 'ajouter l'attribut Dim attributeObj As AcadAttribute Dim H_TXT As Double Dim mode As Long Dim ETIQUETTE As String Dim insertionPoint(0 To 2) As Double Dim TAG As String Dim VALEUR As String height = 1# mode = acAttributeModeVerify ETIQUETTE = "Attribute Prompt" insertionPoint(0) = 1#: insertionPoint(1) = 1#: insertionPoint(2) = 0 'je ne sais pas ou doivent etre ton attribut par rapport à ton bloc TAG = Attribut 'creation de l'attribut dans le block Set attributeObj = blockObj.AddAttribute(H_TXT, mode, ETIQUETTE, insertionPoint, TAG, text)
je ne l'ai pas tester je l'ai écrit vite fait dans ton attribut suivant ton style de texte tu risques d'avoir des caracteres spéciaux !
Je vais partir de ça et rajouter les autres conditions

Pour l'emplacement de l'attr pas de problème parce que après je vais extraire les attributs c'est tout, le projet et d'extraire les informations des blocs et les copier sur un Excel. sachant que les projets contiennent seulement des blocs et des textes. Donc l'idée est de laisser à chaque fois le bloc avec le calque contenant le texte du premier attribut. Selectionner tout et transformation en bloc + attribut (je garde bien sur les textes pour vérification),après 2ème calque contenant les textes à convertir en attributs ect.. finalement je veux obtenir un bloc contenant plusieurs attributs pour l'exporter

Voilà j'espère que j'ai tout expliquer

mon soucis dans mon code c'est la condition de prendre le plus proche texte en respectant aussi la distance maximale qui ne doit pas être dépasser ..
#8
Posté 22 janvier 2021 - 12:13
Tu boucles sur tous tes objets :
tu retiens la distance et la valeur
Si la distance et inférieur à ta valeur arbitraire et la distance de ton précédent comparatif tu conserves
c'est tout
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)
Mon site Web (en cours de construction) : Site
#9
Posté 22 janvier 2021 - 14:34
Curlygoth, le 22 janvier 2021 - 12:13 , dit :
Tu boucles sur tous tes objets :
tu retiens la distance et la valeur
Si la distance et inférieur à ta valeur arbitraire et la distance de ton précédent comparatif tu conserves
c'est tout
xD ! ce que jecherche vraiment le point à comparer


Merci beaucoup beaucoup !
#10
Posté 22 janvier 2021 - 14:56
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)
Mon site Web (en cours de construction) : Site
#11
Posté 22 janvier 2021 - 15:19
Curlygoth, le 22 janvier 2021 - 14:56 , dit :
Merci,
vraiment c'est un bon outil de point de vue efficacité et rapidité et surtout sa langage un peu facile par rapport les autres... Heureusement j'ai eu l'occasion maintenant de revenir à développer des macros comme avant !
Je t'encourage pour l'effort que tu as fait pour arriver à créer des macros complexes qui facilite le travail . (j'ai vu le site et quelques vidéos)
Bonne continuation

#12
Posté 23 janvier 2021 - 16:29
Curlygoth, le 22 janvier 2021 - 10:21 , dit :
envoie ton fichier sinon je peux te lancer des pistes :
tu aura certainnement des erreurs mais par manque de temps je donne des pistes :
1°)
boucle sur tous les objets de dessin
2°) verifier si c'est un block ou non / ou txt ou non
3°) verifier la plus courte distance entre bloc et texte e si ca te va tu insrer l'attribut dans le block
sinon tu le rentre manuellement ou tu met rien...
le mode manuel ressemblerait à ça :
(j'ai pas tester !!!!!)
on goto err_ceci_pas_TXT Dim textObj As AcadText ' ou Mtext ! ThisDrawing.Utility.GetEntity text, basePnt, "Sélectionner le texte" text = textObj.textString on error goto 0 on goto err_ceci_pas_BLOCK Dim blockRefObj As AcadBlockReference ThisDrawing.Utility.GetEntity blockRefObj, basePnt, "Sélectionner le block" on error goto 0 'ajouter l'attribut Dim attributeObj As AcadAttribute Dim H_TXT As Double Dim mode As Long Dim ETIQUETTE As String Dim insertionPoint(0 To 2) As Double Dim TAG As String Dim VALEUR As String height = 1# mode = acAttributeModeVerify ETIQUETTE = "Attribute Prompt" insertionPoint(0) = 1#: insertionPoint(1) = 1#: insertionPoint(2) = 0 'je ne sais pas ou doivent etre ton attribut par rapport à ton bloc TAG = Attribut 'creation de l'attribut dans le block Set attributeObj = blockObj.AddAttribute(H_TXT, mode, ETIQUETTE, insertionPoint, TAG, text)
je ne l'ai pas tester je l'ai écrit vite fait dans ton attribut suivant ton style de texte tu risques d'avoir des caracteres spéciaux !
Je pense que le code ne marche pas car il s'agit d'un blockreference quand ne peut pas l'ajouter directement un attribut ( c'est ce qu j'ai compris après mes recherches)
#13
Posté 25 janvier 2021 - 09:32
Citation
Merci ;-) je les personnalise pour mes clients surtout c'est que des exemples !
confond pas
AcadBlockReference et Acadblock ! les types sont en anglais le acadblock c'est plus le groupe !
comme je te l'ai : dit j'ai pas testé
et c'est quoi l'erreur ?
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)
Mon site Web (en cours de construction) : Site
#14
Posté 25 janvier 2021 - 11:12
Curlygoth, le 25 janvier 2021 - 09:32 , dit :
confond pas
AcadBlockReference et Acadblock ! les types sont en anglais le acadblock c'est plus le groupe !
comme je te l'ai : dit j'ai pas testé
et c'est quoi l'erreur ?
Bonjour,
Voici le code maintenant après modifications :
Sub add_Attributes_to_one_block()
Dim obj As AcadBlockReference
Dim block As AcadBlock
Dim inspt As Variant
Dim objname As String
Dim blocks As AcadBlocks
Dim Blk As AcadBlock
Dim textObj As AcadText
ThisDrawing.Utility.GetEntity textObj, basePnt, "Sélectionner le texte"
text = textObj.TextString
Set blocks = ThisDrawing.blocks
ThisDrawing.Utility.GetEntity obj, inspt, "Select object:"
objname = obj.EffectiveName
Set Blk = ThisDrawing.Application.ActiveDocument.blocks(objname)
Dim newatt As AcadAttribute
Dim height1 As Double
Dim mode1 As Long
Dim prompt1 As String
Dim insertionPoint1(0 To 2) As Double
Dim tag1 As String
Dim value1 As String
height1 = 0.1
value1 = "poteau n1"
mode1 = acAttributeModeVerify
prompt1 = "new_attribute"
insertionPoint1(0) = 0
insertionPoint1(1) = 0
insertionPoint1(2) = 0
If Err.Number <> 0 Then
MsgBox "the block does not exist"
Else
'Create new attribute
On Error Resume Next
Set newatt = Blk.AddAttribute(height1, mode1, _
prompt1, insertionPoint1, "Adresse_poteau", text)
If Err.Number <> 0 Then
MsgBox Err.Description
End If
ThisDrawing.SendCommand ("attsync n " & objname & vbCr)
End If
End Sub
c'est le code pour un seul bloc avec un texte, maintenant il faut modifier pour que chaque bloc dans la sélection (bien sur je vais isoler les blocs el les textes à ajouter comme attributs) prend le texte le plus proche comme premier attribut. donc il faut faire une boucle pour tout les blocs sélectionnés et à chaque bloc il faut faire une boucle pour prendre le texte dans lequel son point d'insertion est le plus proche du point de l'insertion du bloc et satisfaisant aussi une distance max "Dmax" sinon il prend la valeur "". j'essaye de développer cette idée mais comme je l'ai dèjà dit il me faut un coude de main pour arriver

#15
Posté 25 janvier 2021 - 11:56
tu as 2 points :
Dim PTB (0 to 2) as double 'point du block (on cherchera à partir de celui la donc ) Dim PTT (0 to 2) as double 'Point du texte qui changera à chaque fois ! for u = 0 to 2 'tu n'as pas besoin de boucle tu peux aussi faire : PTB = obj.InsertionPoint (mais quand tu debogs et tu tu connais pas les espions c'est ce que je faisais avant et c'est resté XD) PTB(u) = obj.InsertionPoint(u) PTT(u) = textObj.Insertionpoint(u) next u D = sqr((PTB(0) - PTT(0))^2 + PTB(1) - PTT(1))^2)
fais en une fonction et conserve la valeur la plus petite
a la fin tu regarde si ta valeur est plus petite que ta tolérance
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)
Mon site Web (en cours de construction) : Site
#16
Posté 25 janvier 2021 - 12:33
Curlygoth, le 25 janvier 2021 - 11:56 , dit :
tu as 2 points :
Dim PTB (0 to 2) as double 'point du block (on cherchera à partir de celui la donc ) Dim PTT (0 to 2) as double 'Point du texte qui changera à chaque fois ! for u = 0 to 2 'tu n'as pas besoin de boucle tu peux aussi faire : PTB = obj.InsertionPoint (mais quand tu debogs et tu tu connais pas les espions c'est ce que je faisais avant et c'est resté XD) PTB(u) = obj.InsertionPoint(u) PTT(u) = textObj.Insertionpoint(u) next u D = sqr((PTB(0) - PTT(0))^2 + PTB(1) - PTT(1))^2)
fais en une fonction et conserve la valeur la plus petite
a la fin tu regarde si ta valeur est plus petite que ta tolérance
Mercii, Je commence tout de suite à coder

Bonne journée et bon travail

#17
Posté 26 janvier 2021 - 09:31
Teamscad, le 25 janvier 2021 - 12:33 , dit :

Bonne journée et bon travail

Bonjour

j'ai un problème: j'ai créé le bloc avec attribut dans un fichier et je l'ai appelé pour remplacé le bloc existant, mais le moment ou je teste avec has.attributes il renvoie false, sachant que le bloc que j'ai créé contient 2 attribut.Peut être ma définition du bloc avec attribut est fausse ??

#18
Posté 26 janvier 2021 - 10:31
ou alors ton blocs n s'est pas mis à jour dans ton dessin... il peut y avoir un multiple d'erreur de code ^^
quand tu remplaces il te faut deux types acadblockreference ou 1 seul mais dans ce dernier cas faut "vider" la classe
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)
Mon site Web (en cours de construction) : Site
#19
Posté 26 janvier 2021 - 10:42
Curlygoth, le 26 janvier 2021 - 10:31 , dit :
ou alors ton blocs n s'est pas mis à jour dans ton dessin... il peut y avoir un multiple d'erreur de code ^^
quand tu remplaces il te faut deux types acadblockreference ou 1 seul mais dans ce dernier cas faut "vider" la classe
J'ai utilisé deux types de références; sur bloc de référence existant, j'ajoute le nouveau bloc avec les points d'insertions de ce dernier puis je l'écrase. jusqu'à le remplacement de tous les blocs.. autre problème que j'ai constaté.. lorsque je calcule la distance entre le texte et le point d'insertion je trouve pas les points d'insertions dans l'espace d'objets mais celui du bloc (X=0, Y=0)..


[Public Sub UpdateBlockWithAttribute(existingblks As AcadBlockReference)
Dim newBlks() As Variant
Dim extBlk As AcadBlockReference
Dim newBlk As AcadBlockReference
Dim i As Integer
Dim newBlkFile As String
newBlkFile = "C:\Users\Administrateur\bloc.dwg"
If UBound(existingblks) > 0 Then
For i = 0 To UBound(existingblks)
Set extBlk = existingblks(i)
'' Create new block reference
Set newBlk = ThisDrawing.ModelSpace.InsertBlock( _
extBlk.InsertionPoint, newBlkFile, _
extBlk.XScaleFactor, extBlk.YScaleFactor, extBlk.ZScaleFactor, extBlk.Rotation)
ReDim Preserve newBlks(i)
Set newBlks(i) = newBlk
'' Erase existing block
extBlk.Delete
Next
End If
End Sub]
#20
Posté 26 janvier 2021 - 11:18
[Public Sub UpdateBlockWithAttribute(existingblks As AcadBlockReference)
existingblks c'est ton bloc existant pou moi 1 block et donc c'est pas une collection si ?
For i = 0 To UBound(existingblks) ' tu boucle sur ton block ?
Set extBlk = existingblks(i)
mais je vois pas la recherche de ton texte et sa position
Et maintennant ? Ben, je ne dessine quasiment plus...
Je programme pour que mon ordinateur travail à ma place
Et je créé des outils pour gérer planning, mail auto, rapport issu du dessin et j'en passe.
(Uniquement en VBA et VB.net / Sql)
Mon site Web (en cours de construction) : Site