Permutações

Uma subrotina para permutações.
Ver...
(defun permuteme (lst / global recursive subst2 swap)
  (
setq
    ;função que substitui um elemento por outro numa lista:
    subst2 (lambda (lst pos elm / tmp)
         (
repeat pos
           (Setq tmp (cons (car lst) tmp)
             lst (cdr lst)))
         (
append (reverse tmp) (list elm) (cdr lst)))

    ;função que inverte as posições de 2 elementosnuma lista:
    swap   (lambda (lst p1 p2)
         (
subst2 (subst2 lst p2 (nth p1 lst)) p1 (nth p2 lst)))

    ;função recursiva que cria as permutações
    recursive (lambda ( k / i len)
        (
setq len (length lst))
        (
if (= k len)
          (
setq global (cons lst global))
          (
progn
            (setq i k)
            (
repeat (- len k)
              (
setq lst (swap lst i k))
              (
recursive  (1+ k))
              (
setq lst (swap lst i k)
                i   (1+ i)))))))
  ;inicia a função recursiva, ela cria a lista global:
  (recursive 0)
  

  ;devolve a lista de permutações:
  global)

Com ela é possível criar uma lista com todas as permutações possíveis de uma lista, exemplo: (permuteme '(a b c d)) retorna:
((D A B C) (D A C B) (D C A B) (D C B A) (D B A C) (D B C A) (C D B A) (C D A B) (C A D B) (C A B D) (C B D A) (C B A D) (B D A C) (B D C A) (B C D A) (B C A D) (B A D C) (B A C D) (A D B C) (A D C B) (A C D B) (A C B D) (A B D C) (A B C D))

Estaca Inicial

Civil 3d... é até parece perfeito, mas... algumas vezes depois de criar aquele alinhamento enorme, colocar todas as labels, criar perfis, etc, me aparece alguem e diz: "a estaca inicial não é essa!! é xxx", onde xxx é o número de sorte do camarada... bem, a principio é so mudar o parâmetro "station" em "Station Control" nas propriedades do alinhamento, mas e os greides? terás de mover os PIVs na mão... os profileviews também... pensando nisso, criei este programinha ver...
(defun c:defestini (/ ent vla old delta lock lst tmp)
;inicializa controle de erros:
  (tbn:error-init nil)
;se selecionou um alinhamento:
  (if (setq ent (ssget ":S" '((0 . "AECC_ALIGNMENT"))))
;se obter a estaca inicial:
    (if (setq staini (getreal "\nQual a estaca METRICA inicial?"))
      (
progn
;pega o VLA-OBJECT do alinhamento:
        (setq vla   (vlax-ename->vla-object (ssname ent 0))
;pega a estaca inicial dele:
              old   (cvlp-get-ReferencePointStation vla)
;calcula a diferença:
              delta (- staini old))
;seta a nova estaca inicial:
        (cvlp-put-ReferencePointStation vla staini)
        

;altera as estacas de todos os PIVs dos GREIDES:
        (vlax-for tmp (cvlp-get-profiles vla)
;se o perfil é GREIDE (não vale superimposed nem perfil do terreno)
          (if (= cvlc-aeccfinishedGround (cvlp-get-type tmp))
            (
progn
;pega a lista de PIVs do perfil:
              (setq lst nil)
              (
vlax-for pvi (cvlp-get-pvis tmp)
                (
setq lst (cons (list (cvlp-get-station pvi) pvi) lst)))
;ordena-os por estacas crescentes ou decrescentes:
              (setq lst (vl-sort lst '(lambda (e1 e2) (< (car e1) (car e2))))
                    lst (if  (> delta 0) (reverse lst) lst))
;para cada PIV, altere a estaca
              (foreach pvi lst
                (vl-catch-all-apply 'cvlp-put-station
                  (list (cadr pvi) (+ (car pvi) delta)))))))
        

;altere as estacas de todos os profile view:
        (vlax-for tmp (cvlp-get-profileviews vla)
;destrava as estacas, para poder alterar:
          (setq lock (cvlp-get-StationLocked tmp))
          (
cvlp-put-StationLocked tmp :vlax-false)
          

;se as estacas irão aumentar:
          (if (> delta 0)
            (
progn
;altera primeiro a estaca final
              (cvlp-put-stationend tmp (+ (cvlp-get-stationend tmp) delta))
              (
cvlp-put-stationstart tmp (+ (cvlp-get-stationstart tmp) delta)))
            (
progn
;altera primeiro a estaca inicial
              (cvlp-put-stationstart tmp (+ (cvlp-get-stationstart tmp) delta))
              (
cvlp-put-stationend tmp (+ (cvlp-get-stationend tmp) delta))))
;se o profile view tinha as estacas travadas, trava novamente:
          (if (= :vlax-true lock) (cvlp-put-StationLocked tmp lock))))))
  (
tbn:error-restore))


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

Com ele, basta selecionar o alinhamento em planta e dizer o valor da estaca inicial, assim ele irá aplicar isso ao alinhamento, ao greide e ao profileview.
Fuinciona bem se o profileview não estiver "splitado", para esses terá de colocar os splits manualmente... ainda... não achei a maneira de alterar isso