AU Brasil 2011

5 milhões de comentários
Móóóóóó'legal o AU Brasil!!! Acredito que todas as pessoas que foram também gostaram!!!

Eu particularmente achei muito legal,ainda mais porque pude encontar muitos amigos online por lá
Chegando lá, tudo estranho... novo... Vamos bater uma chapa pra patroa ver que eu fui lá mesmo, hehehe



Logo de cara encontrei o Iuri:

Esse camarada eu conheço a um bom tempo já, mas sempre nos falamos pelo skype. Foi a oportunidade de ver o figura, hehehhe

Mal chegamos, meu passe e o dele não estavam impressos... e ele conseguiu um de Speaker!!

Depois, na primeira palestra, que foi sobre recuperação de pista de pouso, que aliás, eu gostei muito de saber sobre a subassembly OverlayMillAndLevel2, a palestra ficou um pouco lenta no final e não pudemos ver todos os tópicos, mas só essa subassembly aí já valeu

Lá na platéia algumas pessoas vieram falar comigo, me reconheceram daqui do blog, hehehe, claro que ao vivo a minha foto de perfil não condiz muito...

Foram estes:
É a foto não ficou boa, mas esperar o quê dum celular, hehehe, são eles: Márcia, Eu, Paulinho Guerini, Jhony Santos e Tito Rezende da esquerda para a direita. Estes tres ultimos da Guerini Planejamentos.
Aí a gente conversando e tal, comentei do blog novo, aquele, a palestra seguiu e eu me toquei: a fotógrafa foi a Milena, uma das autoras do blog!!! Hehehehe, não podia deixar passar, foto nela também:



Terminada a palestra, troquei umas idéias com o Daniel Queiroz, mas o caraa é liso, não consegui uma chapa com o cara, hehehe

Intervalo e conheci o Luciano:


Fomos fazer a certificação no final da tarde, Tá aí a foto meu velho!!!

De tarde assisti a paletra do gringo, não lembro o nome, hehehe, ele falou sobre o VAULT e suas utilidades e vantagens. Realmente muito bom, mas my english is too bad, man... em fim, tentei perguntar a ele como fazer pro corridor aparecer no desenho que tem as sheets. A idéia dele era: temos um desenho que serve para projetar, nele, não esquentamos a cabeça com estilos e labels. Noutro desenho, puxamos o alinhamento por datashortcut, bem como o greide e a superfície do terreno e geramos as sheets, com o view frame group. Até aí tubo beleza, mas e o corredor????
Se eu precisar mostrar os offsets, tô lascado porque o corredor não aparece no datashortcut... Xref?
Nem, fora de questão, já que ele foi projetado no desenho de projeto, digamos que este desenho é um bocado poluído e um tanto desorganizado... Bem... quem sabe na próxima... A solução ainda é explodir o corredor temporariamente e pegar as coisas que você precisa..

Mais tarde, tava faltando a foto do Anderson:

Conversamos bastante, já nos falavamos a muito tempo na internet, mas só agora podemos nos conhecer ao vivo, valeu cara!!!

Também conheci o Lecius:
Cara, vi o seu template de seção transversal do DNIT, show de bola!! Quanto a berma, faz o que eu falei, vincule a expression ao offfset por enquanto, com uns IFs... Vou adaptar o DaylightBench2  pra colocar point codes numerados nas banquetas, acho que isso simplificará pra caramba

Uma hora apareceu um outro camarada, esse eu ainda não tinha conversado na net, pelo menos até ele mencionar que já havia adquirido uma licença do EXPGE. É o Juliano (me vê seu email ou página!!!):
Depois fui ver a palestra sobre tuneis, um corredor impossível. Todos estavam com a espectativa lá em cima, afinal não há subassembly pronta pra isso. Ele resolveu com polilinhas, fazendo subassembly from polyline
Bom, contado o truque, valeu a palestra, o cara era bem humorado e ele só gastou 46 minutos a mais do tempo total de 1 hora que ele dispunha, hehehe. Todo mundo queria ver até o fim!!! Ah, olha essa figura:
Vê onde eu marquei com a setinha de vermelho? É o nome da aba no toolpallets dos subassemblies.

Hehehe, ri muito!!! É o meu nome!!! hehehe a imagem não ficou boa, mas creio mais alguem tenha notado. O notebook usado na apresentação, segundo p o palestrante era do daniel queiroz, hehehe, se explique meu jovem!!!

Nisso já era quase 19h, hora em que eu ia fazer o tão falado teste de certificação... Durante a espera, conheci ainda o Gilberto, o Jefferson, demos muitas risadas e depois de tanta espera me vem o camarada da carvajal, dizendo que, como já era tarde, eles não poderiam terminar todos os testes... Como assim Bial??? Cara, eu saí do maranhão pra ir lá e o cara me vem com uma dessas??? não mesmo!!! Ele foi lá, demorou um pouco e voltou: nós íamos fazer o teste, hehehe olha aí a cara de alivio:



Bom, finalmente fiz o mardito teste. Quem fez há de concordar comigo que a maior barreira era o inglês, porque as questões eram bem acessíveis, nada de pegadinhas ou perguntas absurdas... Errei uma só sobre parcels, porque não sabia a tradução pra uma expressão no contexto da pergunta: Swing Line, veja ela aqui:
A pergunta era: como dividir uma área em N partes de mesma área, as opções eram as que estão no menu... Claaaro que eu chutei essa... errei... quem souber a resposta, posta aí!!!

Perdi a confraternização final por conta do teste que acabou atrazando.. uma pena.... Ô tava chique!!! tinha champagne, wiski, cerveja.... só sobrou duas brahmas, no fundo do balde pra eu e o iuri (aquele lá em cima) fechar o dia, hehehe

Pra finalizar:


Bom, é isso, desculpe se esqueci de alguem, mas em fim... Gostaria de agradecer a todos os novos amigos que fiz neste dia, todos contribuiram para a grandiosidade do evento e espero ver essa turma em otras ocasiões!!!

Se você recebou o email e preencheu o questionário, eles te mandam o certificado de participação:

Estiloso né?

Civil 3D - Tutoriais - Parte 5.01 - Curva Reversa

1 milhões de comentários
Semana passada fizemos um pequeno treinamento aqui no escritório, para explicar como desenahr curvas reversas no civil 3d.
Na verdade, é bem simples, Se você ja leu o tutorial sobre alinhamentos, já deve estar familiarizado com as ferramentas inicias para desenhar, senão, então relembre agora!!!

Curva reversa, quando fazemos "na mão", normalmente desenhamos as tangentes, localizamos s pontos notáveis e pronto:

Em seguida, lançamos as curvas circulares, no caso do Civil 3D, usariamos as "Free Curve Fillet", no caso aquela do "Between two entities, radius":



Não sei se vocês notaram, mas as vezes nem dá pra fazer isso, pelo menos nas versões anteriores, dava erro ao fazer o PT da primeira curca coincidir com o PC da segunda, pelo fato de gerar uma tangente de comprimento zero.

No 2012 deu, claro, hehehe, nem que seja pra contrariar, hehehe

Agora, notaram, que aparece PT no lugar do PCR?
Esse é o inconveniente...

Mas e como fazer aparecer certo?. bom, primeiro apague as duas curvas, se você as fez e apague também a tangente do meio, deve ficar assim:


Note que o estaqueamento deve parar no final da primeira tangente, note ainda, que na construção anterior, eu marquei os pontos notáveis. Eles servirão apenas para mostrar como usar as ferramentas a seguir.

A primeira ferramenta, será a "Floating Curve (From entity end, through point)":


Note que "estrechei" o final da tangente para a posição do primeiro PC, em seguida cliquei o comando acima e escolho a primeira tangente, parando no PCR:



Note como os pontos coincidiram.

Depois movi o inicio da segunda tangente para o segundo PT, só para que a construção produzisse a imagem das curvas já prontas
Por fim, usei a última ferramenta, "Free Curve Fillet (Between two entities, through point)":

Selecionando o a primeira curva, e a tangente, enquanto que o "through point" ficou sendo o "midpoint" que marquiri de vermelho

Antes que você pergunte, não precisa construir a curva reversa e apagar e fazer todo esse procedimento, eu so fiz isso pra ter pontos de referência, ok? Veja:


Então agora veja a label do PCR, ela apareceu:


Mas aí tu reclama: cadê o PI?????? Reclamou?

No civil 3d 2012 (e só nesse, nos anteriores não tinha isso), edite o estilo do alinhamento e ligue "Tangent Extensions"


Depois em "Alignment Properties, na aba "Point of Intersection", marque a primeira opção:



Poderia ser a segunda opção? vai depender da construção do alinhamento.... Olhe as figuras!!!

Veja como fica:



tem outras formas? tem, é só escolher as ferramentas de construção!!! O legal é perceber que os pontos mantém as tangencias, por causa das restrições da construção.
Quando você lê free, fixed e floating nas ferramentas, significam que a entidade criada terá graus de liberdade diferentes de outras. por exemplo, se você usar a "fixed curve 3 points", ela não é reconstruida por ação em outras linhas, já as floating e free são dependendes das entidades anterior e ou posterior a ela. Mas isso é assunto para outro tutorial, hehehe

É isso. Fácil né?

TBN2NET e Civil 3D 2010

0 milhões de comentários
Como algumas pessoas ainda usam o civil 3D 2010, resolvi disponibilizar o TBN2NET nesta versão também
Nem todos os comandos puderam ser portados, mas os mais usados foram.

Com destaque ao NOTASERV, que traz mais novidades em relação a ultima aparição deste no civil 3d 2010 (versao c312 de 03/05/2011)

Para aqueles que tem registro do NOTASERV desta versão, peço que entre em contato comigo para fazermos a atualização da licença.

Renomear blocos anônimos

1 milhões de comentários
Hoje eu precisei renomear uns blocos anônimos, sabe aqueles, com nomes tipo *U32 e coisas do tipo Aí eu pensei, será que dá? Afinal, normalmente a gente só dá um purge e já era, hehehe Tentei o comando RENAME, mas... os nomes não estavam ali!!! Pensei num lispezinho básico, funcionou, heehehe
acho que poderá ser útil para mais alguem:

(DEFUN C:RENOMEIA (/ ENT NOME VLA ACAD DOC LST)
  (
VL-LOAD-COM)
  (
SETQ    ENT  (CAR (ENTSEL "\nSelecione o bloco"))
    NOME (GETSTRING t "\nQual o nome novo?")
    VLA  (VLAX-ENAME->VLA-OBJECT ENT)
    ACAD (VLAX-GET-ACAD-OBJECT)
    DOC  (VLA-GET-ACTIVEDOCUMENT ACAD)
    LST  (VLA-GET-BLOCKS DOC)
    REF  (VLA-ITEM LST (VLA-GET-NAME VLA))
  )
  (
VLA-PUT-NAME REF NOME)
)

É isso!!, Só pra desenferrujar, hehhehe deverá funcionar no cad 2000 em diante

AU Brasil 2011

0 milhões de comentários
Como muitos já devem saber, o AU vai acontecer no Brasil também!!!
E vai ter palestras muito boas e certificações também, particularmente, me interessa a certificação do Civil 3D que, depois de muita discussão, me convenci que terá mesmo, hehehe Bom, espero encontrar muitos amigos por lá, alguns já me perguntaram se eu ia, então estarei lá com certeza, essa experiência será muito bem-vinda!!

Corridor To Solid

0 milhões de comentários
Então lançaam finalmente uma ferramente para converter Corridor para sólido!!! Cara, já não era sem tempo, veja ele aqui A tempos me pedem isso, mas esbarrei sempre num problema: a sintaxe do método que extruda uma shape... Por um lado fico feliz que tenha saído essa ferramenta, mas por outro fico um pouco frustrado de não ter conseguido terminar a minha versão da coisa... hehehe, fazer o quê... Vou testar!!, se alguem quiser ver como era o código fonte da minha versão, me mande um mail

Contador de PI

0 milhões de comentários
No post anterior, fiz um código para criar estilos de labels e de alinhamentos.

Bom, funciona, mas nem todos estão lá muito a fim de baixar o visual studio e testar e compilar, por isso vou dar uma ajudinha, baixe o programa pronto aqui: Download

Somente para Civil 3D 2012

Ah, incluí na label de PI um texto para numerar os PIs, no 2012 tem isso!!! Outra hora mostro como criar essa label e inserir no desenho

Civil 3D .Net e alinhamentos

4 milhões de comentários
Recentemente no escritório me pediram se tinha jeito de colocar cada alinhamento do desenho em um layer próprio, cujo nome tivesse o nome correspondente a ele. Bem, se fosse um ou dois, era so fazer manualmente, mas no caso eram só 113!!!!

Claaaaaaro!!!!! Nem questionei a utilidade disso, mas em fim...
Suponha que temos o alinhamento A e o B
Eles terão os estilos A e B respectivamente
Cada estilo terá seus layers com o nome A ou B como sufixo....

E isso se aplica não só ao alinhamento, mas também às suas labels....

Bom, como não sou louco de largar isso pro estagiário fazer na mão, coisa que ia levar um mês pelo menos, resolvi criar um programa que o fizesse. E saiu isso aí em baixo:

''importa as funções necessárias
Imports Autodesk.AutoCAD.Runtime
Imports Autodesk.AutoCAD.ApplicationServices
Imports Autodesk.AutoCAD.ApplicationServices.Application
Imports Autodesk.AutoCAD.EditorInput
Imports Autodesk.AutoCAD.Geometry
Imports Autodesk.AutoCAD.DatabaseServices
Imports Autodesk.AutoCAD.DatabaseServices.OpenMode
Imports System
Imports Microsoft.VisualBasci
Imports Autodesk.Civil.DatabaseServices
Imports Autodesk.Civil.Land.DatabaseServicse
Imports Autodesk.Civil.Land.DatabaseServices.Styles
Imports Autodesk.AutoCAD.Colors
Imports Autodesk.Civil
Imports Autodesk.Civil.DatabaseServices.Styles
Imports Autodesk.Civil.ApplicationServices
Imports AcadEntity = Autodesk.AutoCAD.DatabaseServices.Entity
Imports System.Collections.Generic

Public Module CriaESetaEstilos
    Private CurrentTrans As Transaction

    ''verifica a exitencia de um layer, 
    ''se nao existir cria e devolve o id do mesmo
    Private Function AddLayer(ByVal nome As StringAs ObjectId
        SymbolUtilityServices.ValidateSymbolName(nome, False)
        Dim TL As LayerTable = DB.LayerTableId.GetObject(ForWrite)
        If Not TL.Has(nome) Then
            Dim l As New LayerTableRecord()
            l.Name = nome
            TL.Add(l)
            CurrentTrans.AddNewlyCreatedDBObject(l, True)
        End If
        Return TL.Item(nome)
    End Function

    Private Function Addlayer(ByVal nome As String,
                              ByVal ltype As String,
                              ByVal cor As ShortAs String
        Dim lay As LayerTableRecord = Addlayer(nome).GetObject(ForWrite)
        Try
            lay.Color = Color.FromColorIndex(ColorMethod.ByAci, cor)
            lay.LinetypeObjectId = AddLtype(ltype)
        Catch
            ED.WriteMessage("addlayer({0},{1},{2}) {3}",
                            vbLf, nome, ltype, cor, Err.Description)
        End Try
        Return nome
    End Function

    ''verifica a existencia dum textstyle, se não existir, cria
    Private Function AddTextStyle(ByVal nome As StringAs String
        SymbolUtilityServices.ValidateSymbolName(nome, False)
        Dim TL As TextStyleTable = DB.TextStyleTableId.GetObject(ForWrite)
        If Not TL.Has(nome) Then
            Dim l As New TextStyleTableRecord()
            l.Name = nome
            TL.Add(l)
            CurrentTrans.AddNewlyCreatedDBObject(l, True)
        End If
        Return nome
    End Function

    ''veifica a existencia dum linetype, se não existir, cria
    Private Function AddLtype(ByVal nome As StringAs ObjectId
        Try
            Dim TL As LinetypeTable = DB.LinetypeTableId.GetObject(ForWrite)
            If Not TL.Has(nome) Then
                Dim l As New LinetypeTableRecord()
                l.Name = nome
                TL.Add(l)
                CurrentTrans.AddNewlyCreatedDBObject(l, True)
            End If
            Return TL.Item(nome)
        Catch
        End Try
        Return ObjectId.Null
    End Function

    ''devolve o nome de uma entidade
    Private Function NameOfObjectID(ByVal id As ObjectIdAs String
        Try
            Dim o As Object = id.GetObject(ForRead)
            Return o.Name
        Catch
            ED.WriteMessage(vbLf & "NameOfObjectID : " & Err.Description)
            Return "erro"
        End Try
    End Function

    ''adiciona uma entidade ao modelspace
    Private Function AddToModel(ByVal e As AcadEntityAs ObjectId
        Dim bt As BlockTable = DB.BlockTableId.GetObject(ForRead)
        Dim btr As BlockTableRecord =
            bt(BlockTableRecord.ModelSpace).GetObject(ForWrite)
        AddToModel = btr.AppendEntity(e)
        CurrentTrans.AddNewlyCreatedDBObject(e, True)
    End Function

    ''verifica se um estilo de label qualquer existe
    ''se existir, limpa seus componentes e devolve o estilo
    ''se nao existir, cria e limpa os componentes 
    ''criados por padrao e devolve o estilo
    Private Function GetStyleClear(ByVal col As Object,
                                   ByVal nome As StringAs LabelStyle
        ''verifica a existencia
        Try
            GetStyleClear = col.add(nome).getobject(ForWrite)
        Catch
            ''cria, pois ele nao existe
            For Each id In col
                If NameOfObjectID(id) = nome Then
                    GetStyleClear = id.getobject(ForWrite)
                End If
            Next
        End Try

        ''limpa os componentes...
        ''pô autodesk, podia ter um metodo Clear aqui...
        For Each s In New String() {"LINHA""TEXTO""Station",
                                    "Geometry Point and Station",
                                    "Line""Line.1""Line.2",
                                    "Point of Intersection",
                                    "Text For Each Curve or Sprial"}
            Try
                GetStyleClear.RemoveComponent(s)
            Catch
            End Try
        Next
    End Function

    ''verifica se existe um estilo, se existir devolve o id,
    '' senao cria e devolve o id
    Private Function GetStyle(ByVal col As Object,
                              ByVal nome As StringAs ObjectId
        For Each id In col
            If NameOfObjectID(id) = nome Then
                Return id
                Exit For
            End If
        Next
        Return col.add(nome)
    End Function

    ''inicia a transação
    Private Sub StartTR()
        CurrentTrans = AcadDOC.TransactionManager.StartTransaction
    End Sub

    ''finaliza a transação
    Private Sub EndTR()
        CurrentTrans.Commit()
        CurrentTrans.Dispose()
        CurrentTrans = Nothing
    End Sub

    ''documento atual do civil 3d, se tem mais de um desenho ativo, 
    ''devolve aquele de onde o programa foi chamado
    Private Function CivilDOC() As CivilDocument
        Return CivilApplication.ActiveDocument
    End Function

    ''devolve o editor, para fazer pedidos na linha de comando
    ''escrever mensagens...
    Private Function ED() As Editor
        Return AcadDOC.Editor
    End Function

    ''documento atual do autocad, se tem mais de um desenho ativo, 
    ''devolve aquele de onde o programa foi chamado
    Private Function AcadDOC() As Document
        Return DocumentManager.MdiActiveDocument
    End Function

    ''devolve o banco e dados do documento atual
    Private Function DB() As Database
        Return AcadDOC.Database
    End Function


    ''função principal
    <CommandMethod("CriaESetaEstilos")>
    Public Sub CriaESetaEstilos()

        ''inicia a transação
        StartTR()

        ''sempre começar com um TRY
        ''assim, se der erro, o TRY garante uma saida 
        ''do programa com a transação sendo finalizada
        ''se isso nao ocorrer, o autocad vai travar, 
        ''pois ficou aberta a transação

        Try
            ''verifica a existencia do textstyle desejado para as labels
            Dim TEXTSTYLE As String = "R60"
            AddTextStyle(TEXTSTYLE)

            ''predefine os pontos de geometria que serão cotados
            Dim dic As New Dictionary(Of AlignmentPointTypeBoolean)
            For Each i In System.Enum.GetValues(
                GetType(AlignmentPointType))
                dic.Item(i) = True
            Next
            ''exclui as lables de mid point
            dic.Item(AlignmentPointType.CurveMidPt) = False


            ''em todos os alinhamentos do desenho, faça
            For Each alinid As ObjectId In CivilDOC.GetAlignmentIds
                ''pegue o alinhamento
                Dim alin As Alignment = alinid.GetObject(ForWrite)

                ''remova todas as labels soltas associadas a ele
                For Each id As ObjectId In alin.GetLabelIds
                    Dim l As Label = id.GetObject(ForWrite)
                    l.Erase()
                Next

                ''crie templates para os nomes dos layers
                Dim sname As String =
                    alin.Name.ToUpper.Replace("EIXO""").Replace("ACESSO""").Trim(" ")
                Dim stipo As String = If(alin.Name.ToUpper.Contains("ACESSO"), "A""")

                ''layer do eixo do alinhamento
                Dim LAYER_EIXO As String =
                    AddLayer(sname, "TRACO-PONTO",
                             If(alin.Name.Contains("ACESSO"), 5, 6))

                ''layer das extension lines, que serao 
                ''substituidas por labels de intersectionpoint
                Dim LAYER_INTERSECTIONPOINT As String =
                    AddLayer("BG" & stipo & "IC-" & alin.Name, "CONTINUO", 7)

                ''layer do major station
                ''como a linha tem q ser em layer diferente do texto,
                '' podemos criar 2 estilos e nao usar estilo para 
                ''minor station, ja que podemos alterar a frequenciada labels
                ''lembrando que uma label so adimite um layer
                Dim LAYER_MAJORSTATION_TEXT As String =
                    AddLayer("BG" & stipo & "R60-" & sname, "CONTINUO", 3)
                Dim LAYER_MAJORSTATION_LINE As String =
                    AddLayer("BG" & stipo & "FET-" & sname, "CONTINUO", 3)

                ''labels dos geometry point
                Dim LAYER_GEOMETRYPOINT_LINE As String =
                    AddLayer("BG" & stipo & "IC-" & sname, "CONTINUO", 7)
                Dim LAYER_GEOMETRYPOINT_TEXT As String =
                    AddLayer("BG" & stipo & "ICR60-" & sname, "CONTINUO", 7)

                ''redefina o estilo do alinhamento e o seu layer atual
                alin.StyleId =
                    Cria_AlignmentStyle(alin, alin.Name, LAYER_EIXO)
                alin.Layer = LAYER_EIXO

                ''adiciona label nos intersection points (PIs)
                Adiciona_PointIntersectionLabel(alin,
                      Cria_PointIntersectionLabelStyle(alin,
                                                       alin.Name,
                                                       LAYER_INTERSECTIONPOINT))

                ''label set do alinhamento
                ''pega:
                Dim LBS As AlignmentLabelSetStyle =
                    GetStyle(CivilDOC.Styles.LabelSetStyles.AlignmentLabelSetStyles,
                             alin.Name).GetObject(ForWrite)
                ''agora limpa os componentes
                While LBS.Count > 0
                    LBS.RemoveAt(0)
                End While

                ''cria as labels de major station
                ''texto
                LBS.Add(Cria_MajorStationText(alin.Name & "-texto",
                                              LAYER_MAJORSTATION_TEXT, TEXTSTYLE))
                LBS.Item(LBS.Count - 1).Increment = 100
                ''linha
                LBS.Add(Cria_MajorStationLine(alin.Name & "-linha",
                                              LAYER_MAJORSTATION_LINE))

                LBS.Item(LBS.Count - 1).Increment = 20

                ''cria as labels degeometry point
                ''texto
                LBS.Add(Cria_GeometryPointLabelText(alin.Name & "-texto",
                                                    LAYER_GEOMETRYPOINT_TEXT, "R60"))
                LBS.Item(LBS.Count - 1).SetLabeledAlignmentGeometryPoints(dic)
                ''linha
                LBS.Add(Cria_GeometryPointLabeLine(alin.Name & "-linha",
                                                   LAYER_GEOMETRYPOINT_LINE))
                LBS.Item(LBS.Count - 1).SetLabeledAlignmentGeometryPoints(dic)

                alin.ImportLabelSet(LBS.ObjectId)
                ''redefine os layers dos labels adicionados pelo labelset
                Redefine_LabelSet_Layers(alin)
            Next

            MsgBox("fim")
        Catch
            ED.WriteMessage(vbLf & Err.Description)
        End Try
        EndTR()
    End Sub

    ''cria um alignmentstyle e devolve o seu id
    ''StNamne é o nome do estilo
    Private Function Cria_AlignmentStyle(ByVal alin As Alignment,
                                         ByVal StName As String,
                                         ByVal layer As StringAs ObjectId

        ''cria ou pega o estilo
        Cria_AlignmentStyle = GetStyle(CivilDOC.Styles.AlignmentStyles, StName)
        Dim alstyle As AlignmentStyle = Cria_AlignmentStyle.GetObject(ForWrite)

        ''redefine as propriedades do mesmo
        With alstyle
            ''eixo principal
            .GetDisplayStylePlan(AlignmentDisplayStyleType.Line).Layer = layer
            .GetDisplayStylePlan(AlignmentDisplayStyleType.Curve).Layer = layer
            .GetDisplayStylePlan(AlignmentDisplayStyleType.Spiral).Layer = layer

            ''demais items da aba display do estilo do alinhamento
            .GetDisplayStylePlan(AlignmentDisplayStyleType.Arrow).Visible = False
            Try
                .GetDisplayStylePlan(AlignmentDisplayStyleType.WarningSymbol).Visible = False
            Catch
                '' ED.WriteMessage(vbLf & Err.Description & vbLf)
            End Try

            ''define todos para bylayer
            For Each i As AlignmentDisplayStyleType In
                System.Enum.GetValues(GetType(AlignmentDisplayStyleType))
                .GetDisplayStylePlan(i).Linetype = "Bylayer"
                .GetDisplayStylePlan(i).LinetypeScale = 1
                .GetDisplayStylePlan(i).Lineweight = LineWeight.ByLayer
            Next

            ''desliga os line extension
            .GetDisplayStylePlan(AlignmentDisplayStyleType.LineExtensions).Visible = False
            .GetDisplayStylePlan(AlignmentDisplayStyleType.CurveExtensions).Visible = False

            ''items da aba marker do estilo de alinhamento
            .BeginPointMarkerStyle = ObjectId.Null
            .CompoundCurveIntersectPointMarkerStyle = ObjectId.Null
            .CurveLineIntersectPointMarkerStyle = ObjectId.Null
            .CurveSpiralIntersectPointMarkerStyle = ObjectId.Null
            .EndPointMarkerStyle = ObjectId.Null
            .IntersectionPointMarkerStyle = ObjectId.Null
            .LineCurveIntersectPointMarkerStyle = ObjectId.Null
            .LineSpiralIntersectPointMarkerStyle = ObjectId.Null
            .MidPointMarkerStyle = ObjectId.Null
            .ReverseCurveIntersectPointMarkerStyle = ObjectId.Null
            .ReverseSpiralIntersectPointMarkerStyle = ObjectId.Null
            .SpiralCurveIntersectPointMarkerStyle = ObjectId.Null
            .SpiralLineIntersectPointMarkerStyle = ObjectId.Null
            .SpiralSpiralIntersectPointMarkerStyle = ObjectId.Null
            .StationReferencePointMarkerStyle = ObjectId.Null
            .ThroughPointMarkerStyle = ObjectId.Null
        End With
    End Function

    ''cria um PointIntersectionLabelStyle
    Private Function Cria_PointIntersectionLabelStyle(ByVal alin As Alignment,
                                                      ByVal StName As String,
                                                      ByVal layer As StringAs LabelStyle

        ''cria ou pega o estilo
        ''sem nenhum componente
        Dim LB As LabelStyle =
            GetStyleClear(CivilDOC.Styles.LabelStyles.
                          AlignmentLabelStyles.PointOfIntersectionLabelStyles,
                          StName)

        ''define o layer
        LB.Properties.Label.Layer.Value = layer

        ''cria um componente de linha do PI ao PC
        Dim linha1 As LabelStyleLineComponent =
            LB.AddComponent("Line.1"LabelStyleComponentType.Line).GetObject(ForWrite)
        With linha1
            .General.Visible.Value = True
            .General.StartAnchorPoint.Value = AnchorPointType.PointOfIntersection
            .General.UseEndPointAnchor.Value = True
            .General.EndAnchorPoint.Value = AnchorPointType.TangentInStart
            .Line.LengthType.Value = LabelStyleLengthType.FixedLength
            .Line.FixedLength.Value = 0.01
            .Line.Color.Value = Color.FromColorIndex(ColorMethod.ByAci, 256)
        End With

        ''cria um componente de linha do PI ao PT
        Dim linha2 As LabelStyleLineComponent =
            LB.AddComponent("Line.2"LabelStyleComponentType.Line).GetObject(ForWrite)
        With linha2
            .General.Visible.Value = True
            .General.StartAnchorPoint.Value = AnchorPointType.PointOfIntersection
            .General.UseEndPointAnchor.Value = True
            .General.EndAnchorPoint.Value = AnchorPointType.TangentOutEnd
            .Line.LengthType.Value = LabelStyleLengthType.FixedLength
            .Line.FixedLength.Value = 0.01
            .Line.Color.Value = Color.FromColorIndex(ColorMethod.ByAci, 256)
        End With

        ''devolve o estilo
        Return LB
    End Function

    ''adiciona o PointIntersectionLabel
    Private Sub Adiciona_PointIntersectionLabel(ByVal alin As Alignment,
                                                ByVal lb As LabelStyle)
        ''em todas as entidades do alinhamento, faça
        For Each E In alin.Entities
            Dim oid As ObjectId = ObjectId.Null
            ''tente adicionar uma label do tipo PointIntersectionLabel 
            ''elas so podem ser feitas em 3 tipos de entidade de alinhamento
            If E.EntityType = AlignmentEntityType.Arc Then
                oid = AlignmentIndexedPILabel.Create(DirectCast(E, AlignmentArc),
                                                     lb.ObjectId)
            ElseIf E.EntityType = AlignmentEntityType.SpiralCurveSpiral Then
                oid = AlignmentIndexedPILabel.Create(DirectCast(E, AlignmentSCS),
                                                     lb.ObjectId)
            End If

            ''se a label foi criada, redefina o seu layer
            If oid <> ObjectId.Null Then
                Dim o As AlignmentIndexedPILabel = oid.GetObject(ForWrite)
                o.Layer = lb.Properties.Label.Layer.Value
            End If
        Next

        ''força uma atualização do alinhamento, senão as labels na aparecem na tela...
        alin.Update()
    End Sub

    ''cria label major station de alinhamento com componente de texto somente
    Private Function Cria_MajorStationText(ByVal StName As String,
                                           ByVal layer As String,
                                           ByVal textstyle As StringAs ObjectId
        Dim ST As LabelStyle =
        GetStyleClear(CivilDOC.Styles.LabelStyles.
                      AlignmentLabelStyles.MajorStationLabelStyles, StName)
        ST.Properties.Label.Layer.Value = layer
        ST.Properties.Label.TextStyle.Value = textstyle


        Dim texto As LabelStyleTextComponent =
            ST.AddComponent("TEXTO"LabelStyleComponentType.Text).GetObject(ForWrite)
        With texto
            .General.Visible.Value = True
            .Text.Contents.Value = "<[Station Value(Um|FSI|P0|RN|AP|Sn|TP|EN|DZY|W0|OLB)]>"
            .Text.Height.Value = 0.002
            .Text.Angle.Value = 0
            .Text.XOffset.Value = 0
            .Text.YOffset.Value = -0.002
            .Text.Attachment.Value = LabelTextAttachmentType.TopCenter
            .Text.Color.Value = Color.FromColorIndex(ColorMethod.ByAci, 256)
        End With

        Return ST.ObjectId
    End Function

    ''cria label major station de alinhamento com componente de linha somente
    Private Function Cria_MajorStationLine(ByVal StName As String,
                                           ByVal layer As StringAs ObjectId
        Dim ST As LabelStyle =
            GetStyleClear(CivilDOC.Styles.LabelStyles.
                          AlignmentLabelStyles.MajorStationLabelStyles, StName)
        ST.Properties.Label.Layer.Value = layer

        Dim linha As LabelStyleLineComponent =
            ST.AddComponent("LINHA"LabelStyleComponentType.Line).GetObject(ForWrite)
        With linha
            .General.Visible.Value = True
            .General.StartAnchorPoint.Value = AnchorPointType.Station
            .General.UseEndPointAnchor.Value = False
            .Line.Angle.Value = -Math.PI / 2
            .Line.FixedLength.Value = 0.002
            .Line.Color.Value = Color.FromColorIndex(ColorMethod.ByAci, 256)
        End With

        Return ST.ObjectId
    End Function

    ''cria label major station de alinhamento com componente de linha somente
    Private Function Cria_GeometryPointLabelText(ByVal StName As String,
                                                 ByVal layer As String,
                                                 ByVal textstyle As StringAs ObjectId
        Dim ST As LabelStyle =
            GetStyleClear(CivilDOC.Styles.LabelStyles.
                          AlignmentLabelStyles.GeometryPointLabelStyles, StName)
        ST.Properties.Label.Layer.Value = layer
        ST.Properties.Label.TextStyle.Value = textstyle

        Dim texto As LabelStyleTextComponent =
            ST.AddComponent("TEXTO"LabelStyleComponentType.Text).GetObject(ForWrite)

        texto.General.Visible.Value = True

        With texto.Text
            .Contents.Value =
                "<[Geometry Point Text(CP)]>=EST <[Station Value(Um|FSI|P2|RN|AC|Sn|TP|EN|DZN|W0|OF)]>"
            .Height.Value = 0.002
            .Angle.Value = Math.PI / 2
            .XOffset.Value = 0
            .YOffset.Value = -0.04
            .Attachment.Value = LabelTextAttachmentType.BottomLeft
            .Color.Value = Color.FromColorIndex(ColorMethod.ByAci, 256)
        End With

        Return ST.ObjectId
    End Function

    ''cria label major station de alinhamento com componente de linha somente
    Private Function Cria_GeometryPointLabeLine(ByVal StName As String,
                                                ByVal layer As StringAs ObjectId
        Dim ST As LabelStyle =
            GetStyleClear(CivilDOC.Styles.LabelStyles.
                          AlignmentLabelStyles.GeometryPointLabelStyles, StName)

        ST.Properties.Label.Layer.Value = layer

        Dim linha As LabelStyleLineComponent =
            ST.AddComponent("LINHA"LabelStyleComponentType.Line).
            GetObject(ForWrite)
        With linha
            .General.Visible.Value = True
            .General.StartAnchorPoint.Value = AnchorPointType.Station
            .General.UseEndPointAnchor.Value = False
            .Line.Angle.Value = -Math.PI / 2
            .Line.FixedLength.Value = 0.04
            .Line.Color.Value = Color.FromColorIndex(ColorMethod.ByAci, 256)
        End With

        Return ST.ObjectId
    End Function

    ''Redefine Layers do label set aplicado ao alinhamento
    Private Sub Redefine_LabelSet_Layers(ByVal alin As Alignment)
        ''em todas as labelgroups, faça
        For Each oid As ObjectId In alin.GetLabelGroupIds
            ''pegue o labelgropu
            Dim l As AlignmentLabelGroup = oid.GetObject(ForWrite)

            ''pegue o seu estilo
            Dim lb As LabelStyle = l.StyleId.GetObject(ForRead)
            ''descubra e sete o layer
            l.Layer = lb.Properties.Label.Layer.Value

            ''impede que o label de texto de major station escreva 
            ''label no inicio e no fim do alinhamento
            ''já que o geometry point faz isso
            If l.LabelType = LabelType.AlignmentMajorStation And
                l.StyleName.EndsWith("texto"Then
                Try
                    l.RangeEndFromFeature = False
                    l.RangeEnd = Math.Floor(alin.EndingStation / 100) * 100
                Catch
                End Try
                Try
                    l.RangeStartFromFeature = False
                    l.RangeStart =
                        (1 + Math.Floor(alin.StartingStation / 100)) * 100
                Catch
                End Try
            End If
        Next
    End Sub
End Module


Faz o teste... Crie alguns alinhamentos, compile o código e rode ele...

Serão criados estilos para:
  • Alinhamento
  • Major Station
  • Geometry Point
  • Alignment Label Set
  • Point of Intersection

Cada item com um layer específico e para cada alinhamento!!!

O código está todo comentado. Ah, rodei no 2012, possivelmente funcione no 2011 também com pouquíssimas alterações

LinkWithin

Related Posts Plugin for WordPress, Blogger...