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)

Muito além do cidadão kane

Se você tem o emule, assista Muito além do cidadão kane dá muito o que pensar...

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..

3dmark world record

Isso que eu chamo de refigeração e overclock extremo!!

Fatallity

bons tempos!!! hehehe, pena que já era!!!

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=100; small_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 l 0 
       q (length lst)) 
  (repeat (1- q) 
    (setq c (1+ l)) 
    (repeat (- q c) 
      (setq r (append r (list (fun (nth l lst) (nth c lst)))) 
           c (1+ c))) 
    (setq l (1+ l))) 
  r) 

(defun todos-contra-todos2 (lst fun / a b lst3) 
  (foreach a lst 
    (foreach b (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 b (setq lst (cdr lst)) 
      (setq lst3 (cons (fun a b) lst3)))) 
  (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...