Lisp não funciona civil 3D 2022

[topografialima]

Usava no cad 2009 e no civil não funciona. Alguem daria uma solução? Grato

 

;CUTFILL.lsp 09/28/98 Jeff Foster
;Traduzido e adaptado por Rodrigo Salomoni
;
;OBJETIVO***
;O propósito desta rotina é permitir ao usuário acumular a soma de corte 
;e aterro de cada seção transversal criada pelo Civil. As seções devem ser
;criadas na proporção de 1:1 (H:V)
;
;NOTA***
;A variável "namelist" abaixo, contém nomes de diretório para a grade
;e do "right-of-way" criados pelo Civil. Estes nomes devem ser atualizados
;para refletir aqueles utilizados na sua sessão corrente.
;
;
; Se você achar esta rotina útil, por favor, contribua conosco com a quantia de $10.00 para:
;         Jeff Foster
;         258 Page Rd.
;         Garner, NC 27529
;         http://www.cadshack.com

(Defun C:CF ()
  (setq

    ; regua é um layer para ser congelado no inicio

    namelist (list "regua" "regua" "bnd_" "40" "0.20" "0.20" "texto_" "corte" "aterro" "6" "3")
    gridlyr (nth 0 namelist)
    gridrw (nth 1 namelist)
    templyr (nth 2 namelist)
    tempclr (nth 3 namelist)
    templyrl (strcat templyr "-l")
    cuthgt (nth 4 namelist)
    fillhgt (nth 5 namelist)
    textlyrl (nth 6 namelist) 
    layer1 (nth 7 namelist)   ;sufixo para templyrl e textlyrl
    layer2 (nth 8 namelist)   ;sufixo para templyrl e textlyrl        
    cor1 (nth 9 namelist)     ;cor para o layer1
    cor2 (nth 10 namelist)    ;cor para o layer2            
    lu (getvar "lunits")
    lup (getvar "luprec")
    sscut (ssadd)
    ssc nil
    ssfill (ssadd)
    ssf nil
    ssc-area nil
    ssf-area nil
    esct 15         
  )
  (PREPROCESS)
  (PROCESS)
  (POSTPROCESS)
 )

(Defun PREPROCESS ()
  (command "undo" "begin")
  (setq
    c_lay (getvar "clayer")
    c_cmd (getvar "cmdecho")
  )

  (if (= (tblsearch "layer" templyr) nil)
    (command "layer" "m" templyr "c" tempclr "" "")
    (command "layer" "s" templyr "")
  )
  (command "layer" "off" gridlyr "")
  (command "layer" "off" gridrw "")
)

(Defun PROCESS ()
  (setq cutpt (getpoint "\nIndique um ponto na área de corte <Enter para área de aterro>: "))
  (while (/= cutpt nil)
 
(command "layer" "m" (strcat templyr layer1) "c" cor1 "" "")

    (bpoly)
    (command cutpt "")
    (setq
      ssc (ssadd (entlast) sscut)
      cutpt (getpoint "\nIndique um ponto na área de corte <Enter para área de aterro>: ")
    )
  )
  (if (/= ssc nil)
    (progn
      (setq ssc-1 (ssname sscut 0))
      (command "area" "a" "e")
      (while (/= ssc-1 nil)
        (command ssc-1)
        (ssdel ssc-1 sscut)
        (setq ssc-1 (ssname sscut 0))
      )
      (command "" "")
   ;apaga o bpoly (command "erase" (ssget "X" (list (cons 8 templyr))) "")
      (setq ssc-area (getvar "area"))
      (DOTEXT)
      (command (strcat (strcat "C = " (rtos ssc-area 2 2)) "m2"))
      (setq ssc-area nil)
      (command "layer" "s" templyr "") ;cria o layer 
    )
  )
  (setq fillpt (getpoint "\nIndique um ponto na área de aterro <Enter para nenhum>: "))
  (while (/= fillpt nil)

(command "layer" "m" (strcat templyr layer2) "c" cor2 "" "")

    (bpoly)
    (command fillpt "")
    (setq
      ssf (ssadd (entlast) ssfill)
      fillpt (getpoint "\nIndique um ponto na área de aterro <Enter para nenhum>: ")
    )
  )
  (if (/= ssf nil)
    (progn
      (setq ssf-1 (ssname ssfill 0))
      (command "area" "a" "e")
      (while (/= ssf-1 nil)
        (command ssf-1)
        (ssdel ssf-1 ssfill)
        (setq ssf-1 (ssname ssfill 0))
      )
      (command "" "")
  ;apaga o bpoly (command "erase" (ssget "X" (list (cons 8 templyr))) "")
      (setq ssf-area (getvar "area"))
      (DOTEXT)
      (command (strcat (strcat "A = " (rtos ssf-area 2 2)) "m2"))
      (command "layer" "s" templyr "")
;     (RESTORESTYLE)
    )
  )
)

(Defun POSTPROCESS ()
  (command "undo" "end")
  (command "layer" "on" gridlyr "")
  (command "layer" "on" gridrw "")
  (setvar "clayer" c_lay)
  (setvar "cmdecho" c_cmd)
)

(Defun DOTEXT ()
  (setq islyr (tblsearch "layer" textlyrl))
  (if (= islyr nil)
    (command "layer" "m" textlyrl "c" tempclr "" "")
    (command "layer" "s" textlyrl "")
  )
  (setq
    txt_styl (getvar "textstyle")
    txt_info (tblsearch "STYLE" (strcase txt_styl))
    c_hgt (cdr (assoc 40 txt_info))
  )

; (if (> c_hgt 0)
;   (FIXSTYLE)
; )

  (cond ((/= ssc-area nil)
    (while (= (setq cpt (getpoint "\nIndique o ponto para texto de corte: ")) nil))
    (command "layer" "m" (strcat textlyrl layer1) "c" cor1 "" "")
    (command "text" "m" cpt "")
        )
        ((/= ssf-area nil)
    (while (= (setq fpt (getpoint "\nIndique o ponto para texto de aterro: ")) nil))
    (command "layer" "m" (strcat textlyrl layer2) "c" cor2 "" "")
    (command "text" "m" fpt "")
        )
  )

)

(Defun FIXSTYLE ()
  (command "-style" txt_styl "" "0")
  (while (= (strcase (getvar "cmdnames")) "-STYLE")
    (command "")
  )
)

(Defun RESTORESTYLE ()
  (command "-style" txt_styl "" c_hgt)
  (while (= (strcase (getvar "cmdnames")) "-STYLE")
    (command "")
  )
)


;(textscr)

;(prompt "\nCertifique-se de que as seções tenham proporção 1:1")
;(prompt "\nExecute CF para delinear as áreas.")
;(princ)
(C:CF)

 

[mhupp]

Did it ever work? Did you look at the notes in the lisp?