CadXP: transformer un bloc + text à un bloc avec attribut - CadXP

Aller au contenu

  • 2 Pages +
  • 1
  • 2
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

transformer un bloc + text à un bloc avec attribut

#21 L'utilisateur est hors-ligne   Teamscad 

  • Member
  • PipPip
  • Groupe : Membres
  • Messages : 15
  • Inscrit(e) : 21-janvier 21

Posté 26 janvier 2021 - 11:29

Voici ma première fonction qui cherche le bloc à remplacer :
Private Function SearchBlockReferences(blkName As String) As Variant
Dim blks() As AcadBlockReference
Dim ent As AcadEntity
Dim blk As AcadBlockReference
Dim i As Integer
For Each ent in ThisDrawing.ModelSpace
If TypeOf ent Is AcadBlockReference Then
Set blk=ent
If UCase(blk.EffectiveName)=Ucase(blkName) Then
ReDim Preserve Blks(i)
Set blks(i)=blk
i=i+1
End If
End If
Next
SearchBlockReferences = blks
End Function
**********
Private Sub UpdateBlockAttribute(blks As Variant)
Dim blk As AcadBlockReference
Dim txt As string
Dim i As Integer
For i = 0 To UBound(blks)
Set blk = blks(i)
txt = FindClosestText(blk.InsertionPoint, 100.0) '' Only texts that is not far from 100.0 is considered
If Len(txt)>0 Then
txt = "No closest text found"
End If
SetAttribute blk, txt
Next
End Sub
****
Private Function FindClosestText(point As Variant, maxDistance As Double) As Text
Dim minDist As Double
Dim txtValue As String
Dim d As Double
Dim ent As AcadEntity
Dim text As AcadText
minDist = maxDistance
For Each ent InThisDrawing.ModelSpace
If TypeOf ent Is AcaddText Then
Set text=ent
d = GetDistanceToBlock(point, text.TextAlignmentPoint)
if d<minDist then
minDist = d
txtValue=text.TextString
End If
End If
Next
FindClosestText = txtValue
End Functon
*********
Private Function GetDistanceToBlock(point As Variant, txtPoint As Variant) As Double
Dim x As Double
Dim y As Double
Dim z As Double
x = txtPoint(0) - point(0)
y = txtPoint(1) - point(1)
z = txtPoint(2) - point(2)
GetDistanceToBlock=Sqr(x*x + y*y + z*z)
End Function
*******
Private Sub SetAttribute (blk As AcadBlockReference, txt As String)
Dim atts As Variant
Dim i As Integer
Dim att As AttributeReference
atts=blk.GetAttributes
For i = 0 To UBound(atts)
Set att = atts(i)
If UCase(att.TagString)="Nom_bloc" Then
att.TextString=txt
End If
Next
End Sub
****
Voilàa: j'espère que j'ai rien oublié, j'ai tapé maintenant parceque mon code est sur l'ordinateur du bureau.
0

#22 L'utilisateur est hors-ligne   Teamscad 

  • Member
  • PipPip
  • Groupe : Membres
  • Messages : 15
  • Inscrit(e) : 21-janvier 21

Posté 26 janvier 2021 - 11:35

existingblk as variant désolé..
0

#23 L'utilisateur est hors-ligne   Curlygoth 

  • ceinture marron
  • Groupe : Membres
  • Messages : 206
  • Inscrit(e) : 09-mai 19
  • LocationJuste devant toi

Posté 26 janvier 2021 - 13:49

alors les points mets les en type double (c'est peut etre pour a que tu as 0)

variant c'est un joker je suis d'accord mais quand tu veux fixer un type et calculer avec fixe le !

pour la boucle sur tes éléments

je te conseil ça :
Dim ent As AcadEntity
For i = 0 To ThisDrawing.ModelSpace.Count - 1
Set ent = ThisDrawing.ModelSpace.Item(i)

ca va te permettre d'aller de 0 à la fin pas par ordre hasardeuse (en tout cas le temps du deboguage ça aide pas mal)
Je dessine sur Autocad depuis mes 16 ans, je fais tout avec 2D/3D etc...
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
0

#24 L'utilisateur est hors-ligne   Seysou 

  • ceinture blanche
  • Groupe : Membres
  • Messages : 4
  • Inscrit(e) : 25-janvier 21

Posté 26 janvier 2021 - 15:31

Voir le messageCurlygoth, le 26 janvier 2021 - 13:49 , dit :

alors les points mets les en type double (c'est peut etre pour a que tu as 0)

variant c'est un joker je suis d'accord mais quand tu veux fixer un type et calculer avec fixe le !

pour la boucle sur tes éléments

je te conseil ça :
Dim ent As AcadEntity
For i = 0 To ThisDrawing.ModelSpace.Count - 1
Set ent = ThisDrawing.ModelSpace.Item(i)

ca va te permettre d'aller de 0 à la fin pas par ordre hasardeuse (en tout cas le temps du deboguage ça aide pas mal)

Je vais voir, sinon pour l'attribut j'ai décomposé le bloc pour avoir un bloc attribut (j'ai vérifié sur le dessin qu'il contient l'attribut) mais toujours dans l'expression :For i = 0 To UBound(atts) la valeur Ubound(atts)=-1 ! j'ai pas compris pourquoi!
0

#25 L'utilisateur est hors-ligne   Curlygoth 

  • ceinture marron
  • Groupe : Membres
  • Messages : 206
  • Inscrit(e) : 09-mai 19
  • LocationJuste devant toi

Posté 26 janvier 2021 - 15:40

For Each att In blockrefobj.GetAttributes 'j'utilise ça
If UCase(att.TagString)="Nom_bloc" Then 'tu as une erreur aussi ici Ucase mais tout en majuscule donc ta condition ne pas pas etre verifié vu que ton texte est en capital...
att.TextString=txt
else
End If
Next att
Je dessine sur Autocad depuis mes 16 ans, je fais tout avec 2D/3D etc...
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
0

Partager ce sujet :


  • 2 Pages +
  • 1
  • 2
  • Vous ne pouvez pas commencer un sujet
  • Vous ne pouvez pas répondre à ce sujet

1 utilisateur(s) en train de lire ce sujet
0 membre(s), 1 invité(s), 0 utilisateur(s) anonyme(s)