Posicao para Civil 3D

Como prometido, uma rotina que usa a collection POINTS do civil 3d, esta rotina converte os pontos de levantamento topográfico inseridos pelo software Posicao, da Manfra para pontos do Civil 3D
ver rotina
(defun c:ptpos2civil (/ ss ent cod pt elev num apt flag xd fun:ents)
  (
tbn:error-init  '(("cmdecho" 0) t))
  (
if aec-pts
    (progn
      (setq fun:ents (lambda (x / p)
                       (
setq x (cdr x)
                             p (vl-string-search "H=" x))
                       (
handent (vl-string-trim " "
                                  (substr x (+ p 3) (- (vl-string-search "DE=" x p) p 2)))))
            ss (ssget '((0 . "POINT") (-3 ("*"))))
            flag (initget "S N" 0)
            flag (getkword "\nApagar os pontos do posição? [Sim, Não] ")
            flag (= "S" (if flag flag "S")))
      (
repeat (if ss (sslength ss) 0)
        (
setq ent  (ssname ss 0)
              xd   (cadr (assoc -3 (entget ent '("*"))))
              cod  (cdaddr xd)
              elev (atof (cdadr xd))
              num  (car xd)
              pt   (cdr (assoc 10 (entget ent)))
              pt   (list (car pt) (cadr pt)))
        
        (
if (and num elev cod pt)
          (
progn
            (setq apt  (vla-add aec-pts (vlax-3d-point pt)))
            (
vlax-put-property apt 'Name num)
            (
vlax-put-property apt 'RawDescription cod)
            (
vlax-put-property apt 'Elevation elev)
            (
if flag
              (foreach x (list ent
                               (fun:ents (nth 4 xd))
                               (
fun:ents (nth 5 xd))
                               (
fun:ents (nth 6 xd)))
                (
if x (entdel x))))
            (
vlax-release-object apt)))
        (
grtext -2 (itoa (sslength ss)))
        (
ssdel ent ss)))
    (
prompt "\nNo Donuts for You!!!!"))
  (
tbn:error-restore t))


Link(s) da(s) subrotina(s) usada(s):
tbn:error-init, aec-pts, tbn:error-restore
Para usar, basta digitar PTPOS2CIVIL na linha de comando (após carregar a rotina, obviamente)

Civil 3d - Pontos

Hoje pra mudar um pouco, vou postar alguma coisa do civil 3d... alguem (assim como eu) já deve ter tentado programar qualquer coisa para ele e, a princípio, fez em VBA, usando os exemplos do próprio programa... mas e em Visual Lisp? será que dá? sim!!! dá!! e nem é tão complicado... que já "conectou" o autocad com o access/excel não vai ter dificuldade nenhuma...

bom, da forma que eu fiz, primeiro defino algumas variáveis globais (que serão usadas em várias subrotinas):

(setq acadapp   (vlax-get-acad-object)
      aec-app   (vla-GetInterfaceObject acadapp "AeccXUiLand.AeccApplication")
      aec-adoc  (vla-get-activedocument aec-app)
      aec-db    (vla-get-database aec-adoc)
      aec-pts   (vlax-get-property aec-db "points")
      aec-surfs (vlax-get-property aec-db "surfaces"))


bom... não vou explicar o que cada função faz... leia o help do civil também, hehehe!!!
estas variáveis serão usadas, por exemplo, nesta rotina:
(defun aec-get-point-by-name (name / lst)
  (
vl-catch-all-apply
    'vlax-map-collection
    (list aec-pts '(lambda (pt) (if (wcmatch (vlax-get-property pt "Name") name) (setq lst (cons pt lst))))))
  lst)



quem usa pontos de levantamento topográfico, sabe que as vezes o ponto vem com o nome duplicado, com caracteres alfanuméricos... mas o PointNumber só aceita número inteiro... nestes casos, em vez de usar a propriedade PointNumber, pode-se usar a PointName, assim o croquis do levantamento terá pontos com nomes coerentes com o desenho do cad... já que PointName aceita caracteres alfanuméricos... assim, se quisermos o(s) ponto(s) de nome "E1" por exemplo, basta usar: (aec-get-point-by-name "E1") e, da maneira que a subrotina foi escrita, pode-se usar: (aec-get-point-by-name "E*") e isto nos retornaria uma lista com os pontos cujo nome comecem com "E"... sacam?

logo posto uma rotina que usa esta subrotina..

Exportar para o Google Earth


estou disponibilizando uma rotina que eu fiz para exportar entidades do autocad para arquivos KML, que podem ser vistos no google earth

versão de testes, hein!!

para usar:
descompacte para a pasta do cad ( ou uma que esteja na "support file serach patch" )

na linha de comando digite :
EXPGE

o resto está no help do programa...

aceito sugestões!!!

link:
ExpGE

Line Type com DCL


Vou postar uma rotina que fiz uns tempos atrás, não tem lá muita utilidade, mas serve para demonstrar como usar o SLIDER de um DCL e como usar alguns métodos de activex...
ver...

Salve o código abaixo em "ltsc.lsp":
(defun c:ltsc  (/ ss ent dcl actsld actref ref lst n
;carrega as vls.... : 
  (vl-load-com
  (
setq 
;subrotina que processa a seleção: 
        actsld (lambda (val /
                  (
setq n 0
                 (
set_tile "prc" (strcat val "%")) 
                  (
repeat (sslength ss
                   (
setq ent (vlax-ename->vla-object 
                               (ssname ss n))) 
                   ;altera a ltscale: 
                   (vla-put-LinetypeScale ent 
                     (* 0.01 (atoi val) ref)) 
                    ;atualiza a entidade: 
                   (vla-update ent
                   (
setq n (1+ n)))) 
;subrotina da ação do edit_box: 
        actref (lambda (val)  (setq ref (atof  val)) 
                 (
actsld (get_tile "sld"))) 
;ltscale de ref erencia inicia em 50% deste valor: 
        ref    2.0

  (
if (setq ss (ssget)) ;se for selecionado algo  
    (progn 
 ;convem ver onde será salva a dcl: 
      (setq dcl (load_dialog "ltscale.dcl"
             lst nil ;ltscale atuais, será preenchido abaixo  
            n   0
;salva as escala atuais, 
;caso pressione o cancel, elas serão restauradas  
      (repeat (sslength ss
        (
setq lst (cons (vla-get-LinetypeScale 
                          (vlax-ename->vla-object (ssname ss n))) 
                        lst
              n   (1+ n))) 
      (
setq lst (reverse lst)) 
;carrega o dialogo: 
      (new_dialog "ltscale" dcl
;inicializa as ações e valores das tiles: 
      (set_tile "ref" (rtos ref 2)) 
      (
action_tile "sld" "(actsld $value)"
      (
action_tile "ref" "(actref $value)"
;inicializa o valor do slider: 
      (actsld (set_tile "sld" "50")) 
; inicia o dialogo  
      (if (= (start_dialog) 0);cancel pressionado:  
;restaura as escala originais: 
        (repeat (sslength ss
          (
setq ent (ssname ss 0)) 
          (
vla-put-LinetypeScale 
            (vlax-ename->vla-object ent
            (
car lst)) 
          (
ssdel ent ss
          (
setq lst (cdr lst)))) 
;descarrega o dcl: 
       (unload_dialog dcl
      )))


e isto com o nome "ltscale.dcl":

ltscale dialog {label "ltscale"
:
edit_box{key="ref"label "ref";
:slider {key "sld" min_value"0" max_value=100small_increment=1;big_increment=10;
:text {key="prc";
ok_cancel
}

para usar, certifique-se de que a rotina e o dcl estão numa pasta da "support file search path" do autocad

CONS e APPEND

Esses tempos postei uma rotina no forum autolisp que iterava uma lista de elemetos e retornava todas as combinações 2 a 2 possíveis nesta lista, sem repetir e não importando a ordem dos elementos, bom, ela funciona tranquilamente, mas se alguem já testou para um grande número de elementos, notou que ele é um tanto LENTA DEMAIS...

Mas por que será? a rotina é pequena, não faz rodeios... em fim... essa semana estive fazendo uns testes com as funções CONS e APPEND do autolisp, pra ver qual retornava resultados mais rápidos... fiz testes tambem entre o FOREACH e o REPEAT

Destes dois últimos, concluí que o FOREACH tem uma pequena vantagem, quase que imperceptível, mas isso deve ser porque para usar o REPEAT, preciso incrementar um índice manualmente... Bom, o caso mesmo é entre o CONS e o APPEND (ou a forma como escrevi os programas... não sei)

Os programas testados são estes:
clique para ver...
;devolve uma lista interada de uma função no estilo todos-contra-todos sem repetir combinações 
(defun todos-contra-todos (lst fun l c q r
  (
setq 
       
(length lst)) 
  (
repeat (1- q
    (
setq (1+ l)) 
    (
repeat (q c
      (
setq (append (list (fun (nth l lst) (nth c lst)))) 
           
(1+ c))) 
    (
setq (1+ l))) 
  
r

(
defun todos-contra-todos2 (lst fun a b lst3
  (
foreach a lst 
    
(foreach (setq lst (cdr lst)) 
      (
setq lst3 (append lst3 (list (fun a b)))))) 
  
lst3

(
defun todos-contra-todos3 (lst fun a b lst3
  (
foreach a lst 
    
(foreach (setq lst (cdr lst)) 
      (
setq lst3 (cons (fun a blst3)))) 
  (
reverse lst3)) 

;rotina para criar uma lista temporaria: 
(defun expandlist (el qtd lst
  (
repeat qtd (setq lst (cons el lst)))) 

;rotina para calcular o tempo de execução: 
(defun testtime (fun t1 t2
  (
setq t1  (getvar "date"
        
t1  (86400.0 (t1 (fix t1)))) 
  (
eval fun
  (
setq t2  (getvar "date"
        
t2  (86400.0 (t2 (fix t2)))) 
  (
t2 t1)) 


;|********************************TESTES***************************** 
;testem as opções: 
(todos-contra-todos3 '(1 2 3 4 5) (lambda (a b) (list a b))) 
   -> ((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5)) 

(todos-contra-todos2 '(1 2 3 4 5) (lambda (a b) (list a b))) 
   -> ((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5)) 

(todos-contra-todos '(1 2 3 4 5) (lambda (a b) (list a b))) 
   -> ((1 2) (1 3) (1 4) (1 5) (2 3) (2 4) (2 5) (3 4) (3 5) (4 5)) 
;todas retornam o mesmo valor... o que é de se esperar 

;criar uma lista com 100 elementos: 
(setq aa (expandlist nil 100)) 

;AVALIAR O TEMPO DE EXECUÇÃO DE CADA UMA DAS SUBROTINAS: 
(testtime '(todos-contra-todos  aa (lambda (a b) nil))) ;2.60996 
(testtime '(todos-contra-todos2 aa (lambda (a b) nil))) ;2.57798 
(testtime '(todos-contra-todos3 aa (lambda (a b) nil))) ;0.0149667 !!!! 
;|

como podem ver nos programas e nos testes, o programa "todos-contra-todos3" obteve um tempo cerca de 200 vezes melhor!!! e detalhe: a lista precessada tinha apenas 100 elementos....

teste com uma lista de 500 elementos, "todos-contra-todos3" obteve um tempo de resposta de 1.07 segundos, já os outros.... ainda estão processando!!!

donde concluo que, usar o CONS é preferível ao APPEND, pois demora menos...
deve ser por que o append avalia a lista TODA ANTES, procura o seu final e aí acrescenta uma nova lista no fim... sei lá....

façam o teste, copiem a rotina e testem... o rogério ( do forum autolisp ) já fez o teste e chegou em valores próximos aos meus...