pv2allalign

Um programa para o civil 3d, e usando algumas das funções da TLB dele!! este programa cria profileviews dos alinhamentos selecionados, util quando se está criando "corridors" com varios alinhamentos auxiliares numa interseção, o como foi um caso em que estou trabalhando, uma rua com 4 cruzamentos, cada um com 4 alinhamentos auxiliares, para criar as concordâncias... ou seja, é muita coisa pra criar profileview um a um, ainda mais que serão temporário..
mais...
;cria profileviews de alinhamentos selecionados
(defun c:pv2allalign (/ ss ent vla pt d llayer lstyle lbandset dcl)
  (
tbn:error-init nil)
  (
if (setq ss (ssget '((0 . "AECC_ALIGNMENT"))))
    (
if (setq pt (getpoint "\nIndique a posição do primeiro Profile View"))
      (
progn
        (setq lstyle   (prof2allalign_getnames (cvlp-get-ProfileViewStyles aec-adoc))
              lbandset (prof2allalign_getnames (cvlp-get-ProfileViewBandStyleSets aec-adoc))
              llayer   (prof2allalign_getnames (vla-get-layers aec-adoc))
              llayer   (vl-remove nil (mapcar '(lambda (x) (if (not (vl-string-search "|" x)) x)) llayer))
              dcl      (load_dialog "f:/autocad/tbn2/lisps/pv2allalign.dcl"))

        (
new_dialog "pv2allalign" dcl)

        (
multi_set_action_tile
          '("style" "layer" "bandset" "prefixo" "separa")
          (
list (list pv2allalign:style lstyle "style")
                (
list pv2allalign:layer llayer "layer")
                (
list pv2allalign:bandset lbandset "bandset")
                pv2allalign:prefixo
                pv2allalign:separa
)
        "(pv2allalign_actions $key $value)")

        (
pv2allalign_mode_tiles)

        (
if (= 1 (start_dialog))
          (
repeat (sslength ss)
            (
setq ent   (ssname ss 0)
                  vla   (vlax-ename->vla-object ent)
                  prof  (cvlm-add
                          (cvlp-get-profileviews vla)
                          (
strcat (if pv2allalign:prefixo pv2allalign:prefixo "") (cvlp-get-name vla))
                          pv2allalign:layer
                          (vlax-3d-point pt)
                          pv2allalign:style
                          pv2allalign:bandset
)
                  d     (get-bounding-box prof)
                  pt    (list (+ (- (caadr d) (caar d)) pv2allalign:separa (car pt))
                              (
cadr pt)))
            (
ssdel ent ss)))
        (
unload_dialog dcl)
        )))
  (
tbn:error-restore))


(
defun pv2allalign_actions (key val)
  (
if (= key "prefixo")
    (
setq pv2allalign:prefixo val)
    (
set (read (strcat "pv2allalign:" key))
         (
nth (atoi val) (eval (read (strcat "l" key))))))
  (
pv2allalign_mode_tiles))


(
defun pv2allalign_actions (key val)
  (
if (= key "prefixo")
    (
setq pv2allalign:prefixo val)
    (
if (= key "separa")
      (
setq pv2allalign:separa (atof val))
      (
set (read (strcat "pv2allalign:" key))
           (
nth (atoi val) (eval (read (strcat "l" key)))))))
  (
pv2allalign_mode_tiles))

(
defun pv2allalign_mode_tiles nil
  (mode_tile "accept" (if (and pv2allalign:layer
                               pv2allalign:style
                               pv2allalign:bandset
                               pv2allalign:separa
) 0 1)))
;variaveis globais
(setq 
  pv2allalign:layer "PERFIL"
  pv2allalign:style "PARALLELA"
  pv2allalign "Standard"
  pv2allalign:prefixo "PV-"
  pv2allalign:separa 20)


Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, aec-adoc, multi_set_action_tile, get-bounding-box, tbn:error-restore
tem uma outra bem parecida que serve para criar os "profile from surface" para estes alinhamentos, outra hora eu posto

inivars

Este trecho de código abaixo, que não é bem uma subrotina, criar algumas variaveis globais que uso nos meus programas e carrega a TLB do civil 3d (2007 e 2008) e deve ser usada sempre que aparecer funções começando com "cvl*". para facilitar, elas estão destatacadas assim: "cvl*", pode parecer estranho, mas se você escreve programas grandes e complicados, deve estar separando o código em varios arquivos e depois junta tudo num VLX... se nao está, deveria, hehehe
mais...
(vl-load-com) ;2008-05-16
(setq acadapp     (vlax-get-acad-object)
      thisdrawing (vla-get-activedocument acadapp))

(
setq aec-ver     (vla-get-version acadapp)
      aec-ver     (vl-position t
                    (list (= aec-ver "17.0s (LMS Tech)");2007
                          (= aec-ver "17.1s (LMS Tech)");2008
                          (= aec-ver "17.2s (LMS Tech)");2009
                        )))
(
IF  aec-ver
  (PROGN
    (SETQ aec-tlb (strcat (vl-filename-directory (findfile "acad.exe"))
              "\\Civil\\AeccXLand"
              (nth aec-ver '("40" "" ""))
              ".tlb"))
    (
if (not (vl-catch-all-error-p
           (Setq aec-app (vl-catch-all-apply
                   'vla-GetInterfaceObject
                   (list acadapp
                     (strcat "AeccXUiLand.AeccApplication."
                         (nth aec-ver
                          '("4.0" "5.0" "6.0"))))))))
      (
setq aec-rod     (vla-GetInterfaceObject acadapp
              (strcat "AeccXUiRoadway.AeccRoadwayApplication."
                  (nth aec-ver '("4.0" "5.0" "6.0"))))
        aec-roaddoc (vla-get-activedocument aec-rod)
        aec-adoc    (vla-get-activedocument aec-app)
        aec-db      (vla-get-database aec-adoc)))

    (
if (findfile aec-tlb)
      (
vlax-import-type-library
    :tlb-filename
 aec-tlb
    :methods-prefix "cvlm-"
    :properties-prefix "cvlp-"
    :constants-prefix "cvlc-"))))

multi_set_action_tile

a subrotina abaixo serve para facilitar a criação de rotinas que usam DCLs, e será útil nas rotinas que estão por vir. Pode parecer meio estranhas no inicio, mas com um exemplo que postarei as coisas irão clarear... mas pelo título do post, dá pra imaginar o que é, não dá?
;vars: lista de strings com as "key" das tiles
;vals: lista dos valores que cada tile irá assumir, tanto na dcl como na variavel
;act:  "string" com a "action" que cada tile irá receber
(defun multi_set_action_tile (vars vals act / m tmp)
  (
setq m "")
  (
setq tmp (vl-catch-all-apply
              '(lambda (vars vals)
                (
if (not vals) (setq vals (mapcar 'eval (mapcar 'read vars))))
                (
mapcar '(lambda (k v / val p)
                           (
if act (action_tile k act))
                           (
setq m k)
                           (
setset_tile2 k v))
                        vars vals))
             (
list  vars vals)))
  (
if (vl-catch-all-error-p tmp)
    (
alert (strcat m "\n" (vl-catch-all-error-message tmp)))))

;|k :key
  v :valor a ser atribuido
      v pode ser:
        real
        int
        str
        nil
        ( "opn" [ou n]        ;valor que a variavel (READ K) irá receber
          ("op1" "op2" "opn") ;lista que polula a popup_list
          "key-popup_list")   ;key da popup_list que será populada
        (0 1 2 3)               ;indices a serem selecionados na popup_list
|;

(defun setset_tile2 (k v / val str l p)
  (
setq val (if v v (eval (read k)))
    str (cond ((= 'real (type val))  (rtos val 2 3))
          ((
= 'int (type val))   (itoa val))
          ((
= 'str (type val))  val)
          ((
null val)  "")
          ((
and (listp val) (listp (setq l (cadr val))))
           (
setq p   (vl-position (type (car val)) '(str int nil))
             tmp (if (= p 0)
                   (
vl-position (car val) l)
                   (
if (= p 1)
                 (
if (< (car val) (length l))
                   (
car val)))))
           (
if (caddr v)
             (
progn
               (start_list (caddr v) 3)
               (
mapcar 'add_list l)
               (
add_list " ")
               (
end_list)))
           (
setq val (if tmp (nth tmp l)))
           (
itoa (if tmp tmp (length l))))
          (
t (if (listp val)
                       (
if (vl-every '(lambda (x) (= 'int (type x))) val)
                         (
l2s val)
                         (
vl-princ-to-string val))
                       (
vl-princ-to-string val)))))
  (
set (read k) val)
  (
set_tile k str))

;transforma lista para string, se forem só numeros
(defun l2s (l /)
  (
setq l (vl-princ-to-string l))
  (
substr l 2 (- (strlen l) 2)))


Link(s) da(s) subrotina(s) usada(s):
setset_tile2, l2s, multi_set_action_tile

get-lst-pih

Aproveitando o post anterior, vou colocar um programa que extrai diversos dados de um alinhamento, tal como raio, angulo central, estcas... veja que é necessário carregar a TLB do civil 3d, senão as funções começando com "cvl*" não irão funcionar
ver rotina...
;|
retorna uma lista (xPI yPI R Teta Dc Cx Cy Sent Lc1 Sc1 EstTsPC EstSc Tc1 Lc2 Sc2 EstStPt EstCs Tc2)
onde:
xPI, yPI - coordenadas do PI
R, Teta, Dc - raio, angulo central, desenvolvimento da parte em ARCO da curva
Cx, Cy - coordenadas do centro da parte em arco da curva
Sentido - "a" anti-horário, "h" horário
Lc1, Sc1 - comprimento e angulo total da espiral inicial
EstTsPC - Estaca inicial da Curva ( circular ou de transição )
EstSc - Estaca inicial do trecho em ARCO de uma curva de transição
Tc1 - comprimento da tangente inicial ( distancia PI EstTsPc )
Lc2, Sc2 - comprimento e angulo total da espiral final
EstStPt - Estaca final da Curva ( circular ou de transição )
EstCs - Estaca final do trecho em ARCO de uma curva de transição
Tc2 - comprimento da tangente final ( distancia PI EstStPt )
(setq vla (vlax-ename->vla-object  (car (entsel))))
(get-lst-pih vla)
|;

(defun get-lst-pih (vla / vlaentities id lst2 n el e pis seco tp x1 y1 x2 y2 a b tmp arc spi spo esi esf)
  (
setq vlaentities (cvlp-get-entities vla)
        id (cvlp-get-FirstEntity vlaentities))
  
  (
repeat (cvlp-get-count vlaentities)
    (
setq e  (cvlm-EntityAtId vlaentities id)
          id (cvlp-get-Entityafter e)
          lst2  (cons e lst2)))
  

  ;inicia as variaveis
  (setq n 1
        ;primeira entidade da lista
        el  (car lst2)
        ;coordenada do ponto inicial:
        pis (list (list (cvlp-get-endeasting el) (cvlp-get-endnorthing el))))

  ;pega todas as entidades e extrai os dados
  (repeat (1- (length lst2))
    (
setq
      ;entidade corrente
      e    (nth n lst2)
      ;entidade anterior
      el   (nth (1- n) lst2)
      ;a entidade é uma linha reta?
      tp   (= cvlc-aecctangent (cvlp-get-type e))
      ;a anterior tb? entao é um PI sem curva
      seco (and tp (= cvlc-aecctangent (cvlp-get-type el)))
      ;estaca inicial e final da entidade
      esi  (cvlp-get-startingstation e)
      esf  (cvlp-get-endingstation e)
      n    (1+ n))

    ;coordenadas do TS,PC e CP,TS
    (cvlm-PointLocationex vla esi 0 0  'x1 'y1 'a)
    (
cvlm-PointLocationex vla esf 0 0  'x2 'y2 'b)

    (
if seco
      (setq pis (cons (list (list x2 y2)) pis))
      (
if (not tp)
        (
setq arc (if (vlax-property-available-p e "Radius")
                    e
                    (if (vlax-property-available-p e "Arc") (cvlp-get-arc e)))
              spi (if (vlax-property-available-p e "SpiralIn") (cvlp-get-SpiralIn e))
              spo (if (vlax-property-available-p e "SpiralOut") (cvlp-get-SpiralOut e))

              ;para compatibilizar com o c3d2k7:
          tmp (inters  (list x1 y1) (list (+ x1 (sin a)) (+ y1 (cos a))) ;vetor direcional
                           (list x2 y2) (list (+ x2 (sin b)) (+ y2 (cos b))) ;vetor direcional
                           nil)
              pis (cons (list
                          ;no c3d2k8 basta:
                          ;(list (cvlp-get-pieasting e) (cvlp-get-pinorthing e))
                          (car tmp)
                          (
cadr tmp)
                          (
if arc (vla-get-radius arc))           ;Raio do arco
                          (if arc (cvlp-get-delta arc))           ;Teta (angulo do arco)
                          (if arc (cvlp-get-length arc))          ;Dc
                          (if arc (cvlp-get-CenterEasting arc))   ;centroX
                          (if arc (cvlp-get-CenterNorthing arc))  ;centroY
                          (if arc (if (= :vlax-true (cvlp-get-clockwise arc)) "h" "a"))

                          (
if spi (vla-get-length spi))           ;Lc1
                          (if spi (cvlp-get-delta spi))           ;Sc1 (angulo)
                          esi                                     ;estaca do TS ou PC
                          (if spi (cvlp-get-endingstation spi))   ;estaca do SC
                          (if spi (distance tmp (list x1 y1)))    ;Tc1

                          (if spo (vla-get-length spo))           ;Lc2
                          (if spo (cvlp-get-delta spo))           ;Sc2 (angulo)
                          esf                                     ;estaca do ST ou CP
                          (if spo (cvlp-get-startingstation spo)) ;estaca do SC
                          (if spo (distance tmp (list x2 y2)))    ;Tc2
                          )
                        pis)))))
  ;ultima entidade:
  (setq e (last lst2))
  ;coordenada do PF (ponto final)
  (cons (list (cvlp-get-starteasting e) (cvlp-get-startnorthing e)) pis))
é isso.. para saber o que cada método, propriedade ou constante faz ou significa, veja o seguinte arquivo: "C:\Arquivos de programas\AutoCAD Civil 3D 2008\Help\civilauto-reference.chm", nele você irá encontrar o help para cada função usada neste programa. Claro, funciona como as funções VL* do visual lisp, onde vc retira o prefixo "CVL*" da função e procura no help, ex: "cvlm-PointLocation", sem o prefixo fica só "PointLocation" e é assim que se deve procurar...
para usar o programa faça, por exemplo:
(setq file (open "c:/teste.txt" "w") lst (get-lst-pih (vlax-ename->vla-object  (car (entsel)))))
(
write-line "(xPI yPI R Teta Dc Cx Cy Sentido Lc1 Sc1 EstTsPC EstSc Tc1 Lc2 Sc2 EstStPt EstCs Tc2)" file)
(
foreach x lst (write-line (tostring x) file))
(
close file)
(
startapp "notepad.exe" "c:/teste.txt")


Link(s) da(s) subrotina(s) usada(s):
tostring

Import type library

Bom, faz tempo que não posto nada, então vou postar um código que stou achando bastante útil:

;importa as funções do civil 3d para o visual lisp
(vlax-import-type-library
 :tlb-filename
 "C:\\Program Files\\AutoCAD Civil 3D 2008\\Civil\\AeccXLand.tlb"
 :methods-prefix "cvlm-"
 :properties-prefix "cvlp-"
 :constants-prefix "cvlc-")


Veja, ele importa os métodos, propriedades e constantes do Civil 3d para o visual lisp

Qual a utilidade disso? bem... você sabe programar em vba? não? sabe em visual lisp?
então.... com isso você pode manipular entidades do civil 3d via lisp!!
um exemplo:
digamos que queiramos obter uma polilinha que passe pelos pontos de um alinhamento... sei lá pra que, mas precisamos fazer isso...
o civil 3d tem um comando que faz o inverso, pega uma polilinha e cria o alinhamento, mas não tem um comando que cria uma polilinha a partir de um alinhamento!! como fazer?
Command: pline ....

bom, veja:

(defun c:alin2pline (/ ss ent)
  (
tbn:error-init nil)
  (
if (setq ss (ssget '((0 . "AECC_ALIGNMENT"))))
    (
repeat (sslength ss)
      (
setq ent (ssname ss 0))
      (
cvlm-GetLWPolyline (vlax-ename->vla-object ent))
      (
ssdel ent ss)))
  (
tbn:error-restore ))


a palavra cvlm-GetLWPolyline so existe APÓS você importar a "type library" do civil 3d que contem o método GetLWPolyline, saca?

essas "type library" estão em "C:\Program Files\AutoCAD Civil 3D 2008\Civil\", no caso do c3d2k8...
agora me pergunte COMO saber que novos métodos você dispõe??

experimente isto:

(setq tmp (atoms-family 1) file (open "d:/cvl.txt" "w"))
(
foreach x tmp
  (if (= "CVL" (strcase (substr x 1 3))) (write-line x file)))
(
close file)
(
startapp "notepad.exe" "d:/cvl.txt")



isto irá criar um arquivo de texto no drive D:\ com todos os métodos, propriedades e constantes importados...

tá, e o help de cada uma delas????????
ache este arquivo:
"C:\Program Files\AutoCAD Civil 3D 2008\Help\civilauto-reference.chm"

abra este tópico:
"AeccXLandLib Library", nele ache "IAeccAlignment Interface"
nele você acha o método que usei no exemplo (GetLWPolyline)
como usar o help?
o help deste método, é algo assim:

Gets the lightweight polyline from alignment geometry.

HRESULT GetLWPolyline(
[out, retval] IAcadLWPolyline ** ppLWPolyline
);


isto é em C, mas é fácil entender...
é quase como os métodos activex ( as famosas VL* ) do cad
ficaria em visual lisp:
(cvlm-GetLWPolyline vlaobj)
onde vlaobj é o vla-object name do alinhamento ( veja o exemplo acima!! )

outro exemplo:
(setq vla     (vlax-ename->vla-object (car (entsel "\nSelecione um alinhamento")))
      station (cvlp-get-startingstation vla)
      offset  0)
(
cvlm-PointLocation vla station offset  'x 'y)
(
prompt (strcat "o ponto inicial é " (rtos x) ", " (rtos y)))


simples né?
o método pointlocation, no help é assim:
HRESULT PointLocation(
[in] double Station,
[in] double Offset,
[out] double* Easting,
[out] double* Northing
);


em lisp, o método PointLocation ficaria:
(cvlm-PointLocation vla station offset 'x 'y)
onde:
"cvlm-" é o prefixo que eu escolho para indicar os métodos
vla é o vla-object do alignment
station é a estaca
offset é a distancia perpendicular ao alinhamento na estaca escolhida

SlideViewer

Não é bem a área, mas é relacionado... vou postar o link de um programinha q fiz para visualizar slides:

download

funciona tanto com slide como biblioteca de slides, e nestas ainda é possivel extrair os slides da mesma
digamos que foi bem interessante programar em vb.net, hehehe
pro primeiro programinha até que tá legal!!

Multiplos ProfileViews


Uma rotina para o civil 3d!!
Então, no civil 3d 2008 tem esta funcionalidade (ver imagem), mas no 2007 não tem... e muitas vezes o profileview fica enorme e é necessário subdividir ele para caber na prancha... como eu disse no 2008 tem isso é bem legal, mas no 2007... em fim, bolei um esquema parecido com o 2008, mas prerferi deixar a cargo do usuário definir os limites de cada profileview. Funciona assim: você cria uma View do alinhamento inteiro (fica enorme eu sei), configura nele tudo o que você quer que apareça, tal como as bandset, perfis que deverão aparecer etc... aí cria retângulos (com o comando rectangle mesmo) em cima que servirão de limitadores para os diversos profileviews que serão criados. Assim, pode-se defini-los com diversos tamanhos inclusive com superposições, de modo a acomodar da melhor forma e de maneira mais rápida que fazer um a um. Em seguida, é rodar a rotina e pronto... dependendo da velocidade da sua máquina pode demorar um pouco... no meu p4 ht de 3.06GB levou 10 minutos para criar 53 profileviews... na mão levei uns 10 para cada um, hehehe, então clica aí pra ver!!
a rotina...
(defun c:createmview (/ view ElevationMin VerticalScale StationStart StationEnd Name
                 minx miny pie psd minxl minyl maxxl maxyl prof ent ss
)

;inicia o controle de erros:
  (tbn:error-init nil)
  
  (
prompt "\Nselecione o profileview modelo")
  (
if (setq view (ssget ":S" '((0 . "AECC_PROFILE_VIEW"))))
    (
if (progn
      (prompt "\nSelecione as polilinhas limitadoras")
      (
setq ss (ssget '((0 . "LWPOLYLINE")))))
    (
progn
;calcula os limites do profileview "pai":
      (setq view          (vlax-ename->vla-object (ssname view 0))
        ElevationMin  (vlax-get-property view "ElevationMin")
        VerticalScale (vlax-get-property view "VerticalScale")
        StationStart  (vlax-get-property view "StationStart")
        StationEnd    (vlax-get-property view "StationEnd"))
      

;calcula a origem do gráfico:
      (vlax-invoke-method view "FindXYAtStationAndElevation" StationStart ElevationMin 'minx 'miny)
      (
setq origin (vlax-3d-point minx miny 0))

;cria os profileview "filhos":
      (repeat (sslength ss)
    (
setq ent    (ssname ss 0)
          prof   (vla-copy view)) ;clona o "pai"
;limites da polilinha:
    (vla-GetBoundingBox (vlax-ename->vla-object ent) 'pie 'psd)
    

;move o clone para o canto inferior esquerdo da polilinha:
    (vla-move prof origin pie)
    

;calcula os limites da polilinha:
    (setq minxl (vlax-safearray-get-element pie 0)
          minyl (vlax-safearray-get-element pie 1)
          maxxl (vlax-safearray-get-element psd 0)
          maxyl (vlax-safearray-get-element psd 1))

;redimensiona o clone ("filho") para os limites da polilinha:
    (mapcar '(lambda (pm pv) (vlax-put-property prof pm pv))
        '("StationLocked"   ;setar em 1 para aceitar os limites abaixo
          "ElevationLocked" ;idem
          "ElevationMin"    ;limites do profileview "filho"
          "ElevationMax"
          "StationStart"
          "StationEnd"
 )
        (
list
          1
          1
          (+ ElevationMin (/ (- minyl miny) VerticalScale))
          (
+ ElevationMin (/ (- maxyl miny) VerticalScale))
          (
+ StationStart (- minxl minx))
          (
+ StationStart (- maxxl minx))))

;libera a memoria ( precisa disso mesmo? )
    (vlax-release-object prof)

;next
    (ssdel ent ss))

;libera a memoria ( precisa disso mesmo? )
      (vlax-release-object view)
      )))


;reestabelece o cntrole de erros do cad:
  (tbn:error-restore)
)


Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, tbn:error-restore

Altitudes no Google Earth

Então, uns testes que estou fazendo aqui, se bem que até agora, obtive umas elevações bem "variadas" por assim dizer... O caso é o seguinte: a rotina a seguir deveria servir para isso: dadas as coordenadas geográficas de um ponto, ela abre o google earth e "pergunta" a ele qual a elevação do ponto na coordenada informada.. bom, deveria ser assim, mas até agora não encontrei uma confiável de de certificar-me que a imagem "estabilizou" na tela, para aí sim, "perguntar" a cota... se ela não estabiliza, o terreno não informa a cota corretamente, e o google earth não está sendo "modal" nos métodos que usei nele.. aos que pensarem que isso se deve a estar programado em lisp, digo que não tem nada a ver... faz o teste, rode a rotina para as coordenadas Lat: -21 e Lon:-48 por exemplo... põe o globo em movimento e rode a rotina pelo console... ela deverá informar cotas estranhas... e se deixar a imagem estabilizar nesta coordenada, ele passa a informar sempre o mesmo valor.. em fim... se estabilizar funciona!!!
imagine as utilidades!! para um anteprojeto de estradas por exemplo, já é um começo se você não tem topografia alguma, hehehe, eu mesmo estou usando este esquema até a topografia ser concluída, aliás, até o geométrico preliminar foi feito no google earth e exportado para o cad com o expge. Se alguém quiser contribuir no desenvolvimento, ou tiver alguma dica, manda aí!!!
mais...
;inicializa o google earth:
(defun getools:init ()
  (
if (setq ge:app (vlax-get-or-create-object "GoogleEarth.ApplicationGE")
        kh:app (vlax-get-or-create-object "Keyhole.khInterface"))
    (
progn
      (while (/= 1 (vlax-invoke-method ge:app "isinitialized")))
      (
while (/= 1 (vlax-invoke-method ge:app "isonline")))
      

      t)
    ))


;calcula a elevação de um ponto na superficie do globo:
(defun getools:elevation-from-pt (lon lat / PointOnTerrain)
  (
if (not kh:app)  (getools:init))
  (
vlax-invoke-method kh:app "setViewParams" lat lon 1000 0 0 5 5)
  (
setq PointOnTerrain nil)
  (
setvar "cmdecho" 0)
  (
while (/= PointOnTerrain
         (setq PointOnTerrain
            (caddr
              (vlax-safearray->list
            (vlax-invoke-method
              kh:app
              "GetPointOnTerrainFromScreenCoords"
              0 0)))))
    (
command "delay" 500))
  (
setvar "cmdecho" 1)
  PointOnTerrain)

;libera a memória:
(defun getools:restore ()
  (
if (equal 'vla-object (type ge:app)) (vlax-release-object ge:app))
  (
if (equal 'vla-object (type kh:app)) (vlax-release-object kh:app))
  (
setq ge:app nil kh:app nil))
Para usar é simples:
(getools:init)
(getools:elevation-from-pt lon lat)
(getools:restore)
onde lat e lon são as coordenadas geográficas do ponto, por exemplo
Lon = -48.5 ( 48º30' Oeste )
Lat = -21 ( 21º00' Sul )

Publicidade: interneyshop