Visual Lisp, GRREAD e OSNAP

Alguém já conseguiu usar o osnap com a função grread? Não sei.. creio que nem dê... essa dúvida apareceu ali no chatbox, então resolvi mostrar uma solução que tinha criado uns tempos atrás para uma lisp que estava fazendo... em fim, ela faz o seguinte: ao ser chamada ela pede a seleção de coordenadas na tela e no final devolve a lista de pontos clicados. É como o comando WIPOUT. Na verdade esse código abaixo foi substituído por uma versão do comando wipeout mais tarde, então este já é obsoleto.
Veja uma imagem de como ele funciona:

Eis o código:

---

(defun get-user-polig  (/ pt circ quad tri qua int1 int2 mark show ins n pts tmp promp p os ad1l)
  (setq n     0
        circ  (repeat 20 (setq n (1+ n) circ (cons (polar '(0 0) (* n (/ pi 10)) 1) circ)))
        quad  '((1 1) (-1 1) (-1 -1) (1 -1))
        tri   (list (list (/ (expt 3 0.5) 2) -0.5) '(0 1) (list (/ (expt 3 0.5) -2) -0.5))
        qua   '((0 1) (-1 0) (0 -1) (1 0))
        int1  '((1 1) (-1 1))
        int2  '((-1 -1) (1 -1))
        ad1l  (lambda (l) (cdr (append l (list (car l)))))
        mark  (list ;cria as listas de coordenadas do blocos OSNAP
                (list quad (ad1l quad)) ;end
                (list tri (ad1l tri)) ;mid
                (list circ (ad1l circ)) ;cen
                (list (append circ int1)(append (ad1l circ) int2)) ;nod
                (list qua (ad1l qua)) ;quad
                (list int1 int2)        ;int
                '(((-1 0) (0 1) (-1 0) (-1 -1) (0 1) (1 0))
                  ((1 0) (0 -1) (-1 -1) (0 -1) (1 1) (1 1))) ;ins
                (list nil nil)          ;per
                (list (append circ '((-1 1)))(append (ad1l circ) '(1 0))) ;tan
                (list (append int1 '((-1 1) (-1 -1))) (append int2 '((1 1) (1 -1)))) ;nea
                (list nil nil);non
                (list (append quad int1) (append (ad1l quad) int2)) ;app
                (list nil nil);ext
                (list nil nil));parl
        show  (lambda (pt n) ;função que desenha o osnap na tela
                (mapcar
                  '(lambda (a b)
                     (grdraw (polar pt (angle '(0 0) a)(* (distance '(0 0) a) (/ (getvar "viewsize") 50.0)))
                             (polar pt (angle '(0 0) b)(* (distance '(0 0) b) (/ (getvar "viewsize") 50.0)))
                             2))
                  (car (nth n mark))
                  (cadr (nth n mark))))
        promp (lambda nil ;função que cria o prompt...
                (setq os  (getvar "osmode") n 0 str "" v "" p nil)
                (repeat 14 ;testa que OSNAP esta ligado
                  (if (= (expt 2 n) (logand os (expt 2 n)))
                    (setq str (strcat str v  "_"
                                      (nth n '("end"    "mid"    "cen" "nod"    "qua"    "int"
                                             "ins"    "per"    "tan" "nea"    "non"    "app"
                                             "ext"    "par")))
                          v   ","))
                  (setq n (1+ n)))
                (prompt (strcat "\nOsmode:" str "\nClique o ponto" (if pts " ou [Undo," "[")
                    "End,Mid,Cen,noD,Qua,Int,inS,Per,(Tan),Nea,nOn,App,(eXt),(parL)]:"))))
  (vl-catch-all-apply ;previne erros e o "ESC"
    '(lambda nil
       (promp);mostra o primeiro prompt
       (while (/= 12 (car (setq tmp (grread t 13))))
         (cond
           ((= 5 (car tmp)) ;mouse se movendo...
            (redraw)
            (setq pt (cadr tmp)) ;cordenada do mouse
            (cond ;testa cada OSNAP, pra ver qual foi pêgo
              ((= 1 (logand os 1)) (if (setq tmp (osnap pt "_end")) (show (setq pt tmp) 0)))
              ((= 2 (logand os 2)) (if (setq tmp (osnap pt "_mid")) (show (setq pt tmp) 1)))
              ((= 4 (logand os 4)) (if (setq tmp (osnap pt "_cen")) (show (setq pt tmp) 2)))
              ((= 8 (logand os 8)) (if (setq tmp (osnap pt "_nod")) (show (setq pt tmp) 3)))
              ((= 16 (logand os 16)) (if (setq tmp (osnap pt "_qua")) (show (setq pt tmp) 4)))
              ((= 32 (logand os 32)) (if (setq tmp (osnap pt "_int")) (show (setq pt tmp) 5)))
              ((= 64 (logand os 64)) (if (setq tmp (osnap pt "_ins")) (show (setq pt tmp) 6)))
              ;((= 128 (logand os 128)) (if (setq tmp (osnap pt "_per")) (show (setq pt tmp) 7)))
              ;((= 256 (logand os 256)) (if (setq tmp (osnap pt "_tan")) (show (setq pt tmp) 8)))
              ((= 512 (logand os 512)) (if (setq tmp (osnap pt "_nea")) (show (setq pt tmp) 9)))
              ((= 1024 (logand os 1024)) (if (setq tmp (osnap pt "_non")) (show (setq pt tmp) 10)))
              ((= 2048 (logand os 2048)) (if (setq tmp (osnap pt "_app")) (show (setq pt tmp) 11)))
              ;((= 4096 (logand os 4096)) (if (setq tmp (osnap pt "_ext")) (show (setq pt tmp) 12)))
              ((= 8192 (logand os 8192)) (if (setq tmp (osnap pt "_par")) (show (setq pt tmp) 13))))
            (if pts (grdraw pt (last pts) 1 1))
            (if pts (grdraw pt (car pts) 1 1))
            (if pts (grdraw (last pts) (car pts) 2 1)))
           ((= 3 (car tmp)) (setq pts (cons pt pts)))
           ((equal tmp '(2 117)) (setq pts (cdr pts)))
           ;uma tecla foi clicada, testa se é alguma dos OSNAP:
           ((setq p (vl-position (cadr tmp) '(101 109 99 100 113 105 115 112 116 110 111 97 120 108)))
            (setvar "osmode"
                    (if (= 10 p)
                      0
                      (if (= (expt 2 p) (logand os (expt 2 p))) (- os (expt 2 p)) (+ os (expt 2 p)))))
            (promp)))
         (mapcar '(lambda (a b) (grdraw a b 5 1)) (cdr pts) pts)
         )))
  (redraw)
  (mapcar '(lambda (x) (trans x 1 0)) pts))

---

Note que alguns códigos de osnap não funcionam bem, basicamente aqueles que dependem do last point....
Endpoint, Midpoint... estes funcionam bem...
É interessante o que a gambiarra faz, hehehe
Se você gosta do lisp e ainda não tinha usado o grread, osnap e o grdraw, essa é a sua chance!!!
No .NET tem algo que resolve isso muiiiito melhor, chama-se JIG, inclusive eu já postei um exemplo de como usar ele aqui

Subassembly Composer

Ufa!!! Finalmente consegui ABRIR o SAC (subassembly composer)

Minha primeira impressão é UAU!!! hehehe

Foi um pouco difícil no começo, até entender o porquê de tantos quadros no programa, mas depois foi susse.

O primeiro subassembly que eu fiz foi uma sarjeta trapezoidal, uma derivação daquela SideDitch. Por isso ela se chama SideDitch2. O desenho dela é assim:

Ela permite colocar declividades diferentes para as paredes internas e externas, possui espessura constante na parede e na base, pode ser trapezoidal ou triangular. Isso supre a maioria, se não todas, as sarjetas que estão no album de projetos tipo do DNIT.

Você pode baixar ela aqui: Download

Só não gostei de uma coisa: pra rodar a subassembly em outras máquinas, é preciso instalar o SAC nelas também.... Aqui no escritório isso é um saco porque tem que pedir pro TI fazer....

Bom, incluí no TBN2NET uma versão feita "a mão" desta mesma subassembly, que não precisa do SAC (roda direto, como as subassemblies nativas do civil 3d) .

Para baixar, clique aqui: Download

A atualização tem ainda uma subassembly de muro. Se você tiver alguma sugestão, me manda!!

Atualização - Civil 3D

Opa!!! mais uma atualização???? 

Calma, calma, dessa vez é do Civil 3D 2012, hehehe

Veja mais sobre ela aqui

No geral "aumenta" a performance.... sei... 

Também corrige alguns bugs em diversos items, tais como alinhamentos, pipes e corridor. 

Se corrige o bug do texto? Não sei, vou testar agora.... ah, ele pede o C3D.msi, então se você está usando o TRIAL apagou a pasta temporária do arquivo de instalação, terá de descompactar ela novamente.

Ah, claro, o TBN2NET também tem atualizações de vez em quando, mantenha o seu sempre atualizado para poder usar as novas ferramentas. A última foi a de importar sondagens para os profileviews

Subassembly Composer. - Túneis

Recebi ontem de um camarada de Portugal, o Luis Gemelgo, duas Subassemblies de túnel:

Feitas no Subassembly Composer. Confesso que ainda não tive tempo de aprender essa ferramenta, coisa que eu pretendo fazer com certeza!!

Bom, a assemblies estão disponíveis para download aqui: Download

Não deixe de visitar a página do Luis: http://www.gttopografia.pt

É um prazer divulgar isto aqui na página, isso mostra que ela tem um ótimo alcance!!! Obrigado camarada!!!

Atualizado 23/11/2011:
Adição de declividade na subassembly. Contribuição do colega jonathan luna lima (cadê a sua página pessoal?)

Civil 3D - Dicas - Cotas do greide no alinhamento

Um monte de gente já me pediu como fazer aparecer as cotas do greide no estaqueamento em planta e eu confesso que so descobri recentemente como fazer... É... usando o reference text, mas pra mim ele teimava em não funcionar... No fim era só eu que não estava fazendo certo, hehehhee

Vamos lá então, crie o seu alinhamento com greide, use este, para testar.

Você deve adicionar labels no perfil para as estacas (Major Station Labels):

Em seguida, vamos configurar a label para mostrar as cotas do greide projetado.

Para isso, abra o editor de estilos para a label de estacas, com o comando EDITALIGNMENTLABELS, depois, clique para editar:

Até aí, susse, a essa altura você ja fez isso um milhão de vezes, heheheh, o truque será adicionar um componente de Reference Text:

Aí, escolha Profile na lista que abriu:

As propriedades do perfil que você poderá usar, são aquelas que normalmente aparecem para labels de perfil, então escolha "Profile Elevation". A formatação é por sua conta.

Clique todos os OK que precisar, vai cair no alinhamento, com um monte de "???" nas labels:

Era aí que eu impacava... Essas interrogações deveriam adivinhar qual é o greide!!! Hehehehe, vamos contar pra ela agora, Abra o Properties, selecione as labels...

Não adianta muito, né? Veja:

É....e aí???????

Faz o seguinte: antes de clicar para selecionar a label group, aperte e segure apertado a tecla CTRL, depois, clique com o botão esquerdo do mouse sobre a label de estaca que tem a interrogação:

Notou que agora você pode selecionar as labels individualmente? Olha o blip da cor CYAN, ele  só aparece nas labels selecionadas... Agora olha no Properties:

Percebeu? Agora clique na caixinha com o e será possível selecionar o perfil do greide. Faça isso.

No final, fica assim:

Viu? depois que a gente descobre, fica até óbvio... Claro, só selecionei duas labels, mas se tiver de fazer em todas, basta selecionar todas e arrumar no properties, usando a tecla CTRL para selecionar as labels individualmente, em vez de selecionar o Label Group...

Esses truques não aparecem no help, ou eu não achei.... em fim...

Se você tem alguma dica, posta aí nos comentários, eu mande um email para que eu coloque aqui na página!!!

Sondagens

Então, fiquei sabendo do tal BoreHole esses dias atravez de um camarada meu, o David e resolvi testar. 

Ele faz o segunte: você chama o programa e ele lê um arquivo contendo as sondagens executadas em um determinado projeto e os desenha em planta como pontos do civil 3d e em perfil, no profilview selecionado.
De cara, é bem interessante, mas começou a empilhar um pouco alguns textos. Depois precisei alterar uns profleviews e tive de reimportar os furos. Mas isso é tranquilo o programa facilita muito isso.  Pra variar, a Vale quer as coisas meio "fora do esquadro"... e pra resolver tive de fazer o meu próprio "importador de furos"... 
Veja uma tela dele:

Lembra o BoreHole, eu sei... Mas tem algumas vantagens: primeiro,você vê os furos antes de importar. Segundo, os furos pode ser projetados em mais de um profileview e caso mude o alinhamento ou o profileview, o programa consegue atualizar os blocos nos perfis.


O formato do arquivo é bem simples e facilita bastante criar ele no excel:
NOME    Furo 01
X    70.0
Y    2.0
Z    15.8
1.5    Areia
2.5    Silte
3.0    Argila

NOME    Furo 02
X    20.0
Y    2.0
Z    15.8
1.5    Silte
3.5    Areia
4.0    Argila




As colunas são separadas por tabulação.



Para representar os furos no perfil, optei por blocos dinâmicos, o que permite fazer alguns "streches" neles. 

Veja como fica em perfil:

É, não configurei muito o profileview, mas já dá pra ter uma ideia.


Ao atualizar algum furo, alinhamento ou perfil, os furos podem ser atualizados no perfil. Note que os blips dão uma grande versatilidade para edição.


Ainda estou trabalhando no programa, mas já dá pra ter idéia de como ele fica, então se você quiser dar alguma sugestão, fique a vontade!!


Roda no Civil 3D 2010 em diante. 


Claro, o programa faz parte do TBN2C3D, então para testar, basta baixar ele aqui.

Bucaneiros

Olha a pérola que eu recebi ontem:

Olá boa tarde...


Estou a procura de um Crack ou serial do seu progama EXPGE, trabalho em uma empresa de topografia, usamos constantemente o google, mas porém o que eu uso aqui é a versão demo amigo que so permite 10 "entidades". gostaria de informaçoes fazendo favor.

 
ATT.

Assim... o expge tá bom o suficiente pra ser pirateado!!!

Será? experimente você também!!!

TBN2NET - Atualizações

Seguindo com as atualizações do TBN2NET!!! Download


Agora, foi a vez do MASSCALC ser incorporado ao TBN2NET, então se você tem o MASSCALC licenciado, entre em contato comigo para procedimentos de atualização da licença.


Também foi atualizado o NOTASERV, que agora também extrai os valores das flechas das curvas verticais. Nele ainda melhorei o sistem a de configurações do numero de casas decimais, formatos de estacas (index, decimal, station format), bem como o tratamento de templates de notas de serviço que estão no rodapé:

Agora as subasemblies fazem parte do pacote, me facilitando o trabalho de atualizações.

Nestas, agora o subassembly de ferrovia tem dois modos de definir as larguras dos ombros de lastro, sublastro e reforço, além do reforço também contar com target de largura.
Incluí também um subasembly para muros verticais, que faz falta as vezes.

No mais, é isso!! Fique sempre atento para a menságem de atualização que o programa dá:

Exploração, licenças caras e outros bichos

Hoje eu vi um comentário  numa postagem minha.

A minha posição é:

Tem?
Bom, vamos lá

Manter atualizações numa mesma versão tem custo.

criar ferramentas novas no mesmo produto também.

 

Acredito que algunas "novas" ferramentas não passam de atualizações das existentes, portanto vender como uma nova ferramente é exploração (seria este o nome?)

A contradição some quando separamos os conceitos de ATUALIZAÇÃO e NOVO, não acha?

Eu tenho este pensamento e sim, meus aplicativos baseados nos produtos da Autodesk tem custo para atualização da LICENÇA para NOVAS VERSÕES, explico:

Portar um programa escrito para uma versão do cad para outra nem sempre é facil e coisas que antes funcionavam, simplesmente páram e você tem que reescrever partes do código.

Exemplo: o EXPGE. Ele é basicamente o mesmo programa a uns 5 anos já. Houveram várias atualizações, você pode ver todas elas no arquivo expge.txt que está no pacote algumas atualizações eu nem marquei lá, então, teria muito mais.... Agora, são atualizações e correções de bugs. Se você adquiriu a licença dele em 2006, ela ainda funciona no AutoCAD 2012, assim como no 2000!!!

Não cobrei nada de nenhum dos assinantes do programa por qualquer uma das atualizações por não considerar nada como "novo" e sim como "atualização"

Mas, então quem paga essa atualização? As novas licenças, claro. Felizmente é um programa com excelente saída!!!

Outros exemplos: TBN2NET e C3DRENESG. Tem versões especificas para cada versão do Civil 3D, desde o 2008 ao 2012. Coisas que funcionam no 2008 de uma forma, precisa ser refeito de outra no 2009 e refeito no 2010 e assim por diante.... Exemplo: no NOTASERV, Como obter a área da seção transversal do material de corte numa sampleline? NO 2011/2012 é simples, tem uma função pra isso na API de programação, mas no 2008, 2009, 2010, não tem e eu preciso escrever um código que beira a gambiarra para obter isso.... Outro exemplo, no C3DRENESG, como substituir um tubo? no 2009 em diante, tem uma função pra isso, mas no 2008 não, eu tenho de apagar o tubo, criar outro novo e refazer todas as conexões...

Então nestes casos, não considero ATUALIZAÇÃO, mas sim NOVO. Isso sem contar as NOVAS funções incluidas e não cobradas dentro da MESMA versão. Se você ler o log de atualizações de ambos, verá a palavra NOVO várias vezes.

Neste caso, quam paga essas atualizações?

Novas licenças e indiretamente os assinantes que atualizam a VERSÃO do Civil 3D. A Autodesk faz isso por meio do Subscription. O meu modelo de negócio é parecido, pois eu cobro uma fração da licença pela atualização.

É um modelo falho? Sim, é, mas e se fosse como o modelo da Microsoft? Cada versão nova do Office é uma licença que você compra certo (me corrija se estiver errado)? Eu uso o 2003 ainda é a melhor versão do Office a meu ver... A M$ ainda dá suporte a ela, ainda atualiza ela gratuitamente, mas se eu quiser o 2010, terei de pagar...

Ah, claro, o preço... Muitos me perguntam o preço dos meus programas e ao ouvirem, dizem: nooooooooooooooooooooosa  que caro!!!!

Tá, defina caro.

Para muitos daquels que disseram  isso eu ofereci trabalho e perguntei o preço.... Projetinho de drenagm, 2000 metros de rede. 5 mil? quanto tempo leva pra fazer com o C3DRENESG? 2 dias? SEM ELE? UMA SEMANA? é o dobro do preço do C3DRENESG.... 

Notas de serviço? modelo DER/DNIT? modelo prefeitura de QualQuerLugarlLopolis? no Acre, Faz? Faz... Este é o serviço do estagiário, uma semana pra fazer na mão usando os reports, pois é um tal de copy/paste em diversos reports diferentes e traduções de inglêspara português.... Com o Notaserv? meia duzia de cliques e pronto. Traduza o tempo economizado do estagiário, que ganha ai seus 10 pilas a hora... você vai achar barato....

Expge? use o trakmaker, nao use o expge.... antes ache alguem que saiba fazer isso direito, depois configure os layers como você quer.... e claro, converta com ele também os KMLs do google earth para o autocad, novamente compute o TEMPO gasto para fazer em outras soluções com o tempo gasto pra fazer com o expge.... É caro?

É... você concorda comigo? legal!! Não? Otimo!!! Quero suas idéias!!!! Comente!!

Civil 3D -more fails....

Já teve situações onde o seu desenho parece que tá bichado? Tipo, estruturas que não conectam com tubos, tubos sem o blips de início e fim, corredores que somem, perfis de superfície que ficam editáveis e perfis de greide que não editam, pontos que somem edições de superfícies que não funcionam, estilos malucos, layers que não apagam.... 

Isso ainda sem contar lentidão inexplicável em máquinas potentes...

Muitas vezes é o caso de um simples AUDIT, por exemplo, abri um desenho meu qualquer e rodei o audit:

Pass 1 3300    objects auditedAcDbViewport(2F7D2)
           Paperspace vport layer Not "0"               "0"
Pass 1 8900    objects auditedAeccDbStructure(715D1)
                     XData Handle Unknown               Null
AeccDbStructure(715D1)

Então.. pau em viewports, xdatas, paperspace, estruturas das pipenetworks...

É, nem só de PURGE vive o autocad, também tem o AUDIT!!!

Um erro estranho introduzido no AutoCAD 2012 que eu também já tive: ocomando DDEDIT faz o texto sumir, não editar, ou dizer o que o objeto está em modo READ ou coisa assim.... Neste caso, basta mudar a variável de sistema DTEXTED para 1. Ela faz o editor do comando ser aquela caixinha tosca do cad 14....

Outro erro besta que aparece aqui de vez em sempre que conecto um projetor no notebook e a resolução fica em 1024x768: Unhandled exception e0434352h, se bem que esse aparentemente tem a ver com o .NET Framework... ele começou a aparecer depois que apliquei as atualizações do civil 3d 2012, até voltei pro estado anterior, o que resolveu em parte, agora so trava ao mudar a resolução....

Outro erro esquisito foi com a variavel VIEWRES, esse eu não lembro bem o por quê, mas parece que dava pau na hora de salvar...

Fica aí umas dicas pra quem tá com problemas parecidos...

Tem algum problema que resolveu? mande aí pra gente!!!

Partbuilder?

 A uns dias que estou quebrando a cabeça com o partbuilder do civil 3d...
Bom, imagino que alguns já tenham se aventurado a usar... se não, ecesse ele no menu pipes:

Ele é quem cria os tubos e estruturas do pipenetwork do civil 3d

Essa ferramenta tem muito potencial, mas se você acessar ele e tiver curiosidade de procurar no google sobre... bem verá que não é tão simples...

Se você mexeu/mexe com esse troço e quer trocar umas idéias, mande-me um email. Preciso de gente que saiba usar ele

AU Brasil 2011

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

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

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

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

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

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

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

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 String) As 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 Short) As 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 String) As 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 String) As 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 ObjectId) As 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 AcadEntity) As 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 String) As 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 String) As 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 AlignmentPointType, Boolean)
            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 String) As 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 String) As 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 String) As 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 String) As 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 String) As 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 String) As 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