Tenha uma nova experiência ao navegar no Fórum pelo computador de forma integrada ao portal principal. Acesse o seguinte link: https://www.autolisp.com.br/board/. Entretanto para dispositivos móveis recomendamos acessar este outro link: https://www.autolisp.com.br/forum/

VBA for AutoCAD - TEXTOS

Dúvidas sobre VB para AutoCAD...

Moderador: Moderadores

Responder
Avatar do usuário
sidneyab
Concreto
Concreto
Mensagens: 89
Registrado em: Seg 09 Mai 2005 12:00:00 am
Localização: Belo Horizonte

VBA for AutoCAD - TEXTOS

Mensagem por sidneyab » Qua 14 Jan 2009 7:29:05 pm

Ola,

E ai gente beleza? Estou tentando aprender o VBA for AutoCAD e tenho uma dúvida. Quando mando o VBA criar um texto e não altero as configurações de alinhamento do mesmo ele fica onde eu especifiquei, porem quando eu alterado estas configurações por exemplo (middle center) o texto vai para o ponto 0,0,0 do desenho alguem pode me ajudar a solucionar o problema segue o código:


Option Explicit

Private Sub item()
'Dim entryestyle As AcadTextStyle
Dim textobj As AcadText
Dim circleobj As AcadCircle
Dim setaobj As AcadLeader
Dim txtstyle As AcadTextStyle
Dim itemnumber As String
Dim txth As Double
Dim txtins As Variant
Dim circleradius As Double
Dim circleins(0 To 2) As Double
Dim setains As Variant
Dim leaderangle As Double
Dim leaderend As Variant
Dim leaderpts(0 To 5) As Double
Dim leaderdist As Double
Dim leadertxt As AcadObject


itemnumber = ThisDrawing.Utility.GetString(0, "Item número: ")

setains = ThisDrawing.Utility.GetPoint(, "Selecione ponto da seta: ")
txtins = ThisDrawing.Utility.GetPoint(setains, "Selecione ponto do balão: ")


circleradius = 4#
circleins(0) = txtins(0): circleins(1) = txtins(1): circleins(2) = txtins(2)

leaderangle = ThisDrawing.Utility.AngleFromXAxis(setains, txtins)
leaderend = ThisDrawing.Utility.PolarPoint(setains, leaderangle, Abs(Sqr((setains(0) - txtins(0)) ^ 2 + (setains(1) - txtins(1)) ^ 2)) - circleradius)
leaderpts(0) = setains(0): leaderpts(1) = setains(1): leaderpts(2) = setains(2)
leaderpts(3) = leaderend(0): leaderpts(4) = leaderend(1): leaderpts(5) = leaderend(2)
Set leadertxt = Nothing


Set txtstyle = ThisDrawing.TextStyles.item("TX100")
txth = txtstyle.Height
Set textobj = ThisDrawing.ModelSpace.AddText(itemnumber, txtins, txth)
textobj.Layer = "TX100"
textobj.StyleName = "TX100"
textobj.Alignment = acAlignmentMiddleCenter 'Se eu não utilizar está linha funciona por quê?
textobj.InsertionPoint = txtins
textobj.Height = txth
textobj.Update

Set circleobj = ThisDrawing.ModelSpace.AddCircle(circleins, circleradius)
circleobj.Layer = "LIN03"
circleobj.Update

Set setaobj = ThisDrawing.ModelSpace.AddLeader(leaderpts, leadertxt, acLineWithArrow)
setaobj.Layer = "COTAS"
setaobj.Update

End Sub


Valeu.[/b]

Avatar do usuário
neyton
Master
Master
Mensagens: 1668
Registrado em: Qui 25 Dez 2003 11:00:00 pm
Contato:

Mensagem por neyton » Qui 15 Jan 2009 2:29:33 pm

do help:

Text aligned to acAlignmentLeft uses the InsertionPoint property to position the text.

Text aligned to acAlignmentAligned, or acAlignmentFit uses both the InsertionPoint and TextAlignmentPoint properties to position the text.

Text aligned to any other position uses the TextAlignmentPoint property to position the text.

ou seja, alguns "text alignments" precisam de TextAlignmentPoint e InsertionPoint outros so do InsertionPoint
talvez seja isso....
como que usa o html daqui?
visite o meu blog: http://tbn2.blogspot.com
lisps exclusivas pra download!!

Avatar do usuário
sidneyab
Concreto
Concreto
Mensagens: 89
Registrado em: Seg 09 Mai 2005 12:00:00 am
Localização: Belo Horizonte

Mensagem por sidneyab » Qui 15 Jan 2009 7:37:53 pm

neyton escreveu:do help:

Text aligned to acAlignmentLeft uses the InsertionPoint property to position the text.

Text aligned to acAlignmentAligned, or acAlignmentFit uses both the InsertionPoint and TextAlignmentPoint properties to position the text.

Text aligned to any other position uses the TextAlignmentPoint property to position the text.

ou seja, alguns "text alignments" precisam de TextAlignmentPoint e InsertionPoint outros so do InsertionPoint
talvez seja isso....
E ai neyton beleza?

Fiz exatamente isso e deu tudo certo usei a propriedade textalignmentpoint e funcionou. Porem agora estou tendo dificuldade para criar o loop no programa assim o usuário usa o quanto for necessário e cancela no fim do jeito que está só consigo desenhar uma indicação por vez.

Eu até fiz mas não gostei do resultado ficou estranho e tenho certeza de que tem coisa sobrando no código. Tentei utilizar alguma função para quando o usuário pressionar o botão esquerdo do mouse, enter ou tecla esc a função se cancelasse e tambem não consegui vou postar a nova rotina.


Option Explicit


Private Sub item()
Dim textobj As AcadText
Dim circleobj As AcadCircle
Dim setaobj As AcadLeader
Dim txtstyle As AcadTextStyle
Dim itemnumber As String
Dim txtins As Variant
Dim circleradius As Double
Dim circleins(0 To 2) As Double
Dim setains As Variant
Dim leaderangle As Double
Dim leaderend As Variant
Dim leaderpts(0 To 5) As Double
Dim leaderdist As Double
Dim leadertxt As AcadObject

On Error GoTo errorcontrol


Do

itemnumber = ThisDrawing.Utility.GetString(0, "Item número: ")
If itemnumber = "" Then
GoTo fim
End If

setains = ThisDrawing.Utility.GetPoint(, "Selecione ponto da seta: ")

txtins = ThisDrawing.Utility.GetPoint(setains, "Selecione ponto do balão: ")


circleradius = 4#
circleins(0) = txtins(0): circleins(1) = txtins(1): circleins(2) = txtins(2)

leaderangle = ThisDrawing.Utility.AngleFromXAxis(setains, txtins)
leaderend = ThisDrawing.Utility.PolarPoint(setains, leaderangle, Abs(Sqr((setains(0) - txtins(0)) ^ 2 + (setains(1) - txtins(1)) ^ 2)) - circleradius)
leaderpts(0) = setains(0): leaderpts(1) = setains(1): leaderpts(2) = setains(2)
leaderpts(3) = leaderend(0): leaderpts(4) = leaderend(1): leaderpts(5) = leaderend(2)
Set leadertxt = Nothing


Set txtstyle = ThisDrawing.TextStyles.item("TX120")
Set textobj = ThisDrawing.ModelSpace.AddText(itemnumber, txtins, txtstyle.Height)
textobj.Layer = "TX120"
textobj.StyleName = txtstyle.Name
textobj.Alignment = acAlignmentMiddleCenter
textobj.TextAlignmentPoint = txtins
textobj.Update

Set circleobj = ThisDrawing.ModelSpace.AddCircle(circleins, circleradius)
circleobj.Layer = "LIN03"
circleobj.Update

Set setaobj = ThisDrawing.ModelSpace.AddLeader(leaderpts, leadertxt, acLineWithArrow)
setaobj.Layer = "COTAS"
setaobj.Update

Loop Until itemnumber = ""

errorcontrol:

fim:
Exit Sub

Select Case Err.Number

Case -2147352567
MsgBox "Cancelado pelo usuário", vbOKOnly, "Cancelado"
Resume fim


Case Else
MsgBox Err.Description
Exit Sub
End Select
End Sub

Responder