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