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