Lisp pour rotation des voiles

[Frankiemr]

Bonjour à tous,

 

j'ai trouvé une lisp que vous trouvez ci dessous pour faire une rotation des coffrages de voiles pour un chantier de batiment.

Par contre la lisp donne un erreur qui est le suivant : erreur: impostation de la variable AutoCAD rejecté: "CECOLOR" "BLANC".

 

Svp il y a quelqu'un qui peut m'aider au sujet ci-dessus

 

Cdt

 

LISP

 

(load (strcat (getenv "RepMeth") "\\e-methodes\\Phas_Voile\\Phas_H"))

(load (strcat (getenv "RepMeth") "\\e-methodes\\Phas_Voile\\Coff_Droit"))

 

(setvar "cmdecho" 0)

 

;;;;;VARIABLES GLOBALES

;

; _iJourCour Jour courant

;=> permet de repérer si la macro a déja été utilisée dans le dessin

; _ssStru Structure sortie triage

; _ssVoil Voiles sortie triage

; _ssVoil Dalles sortie triage

; _iJourMax sortie triage jour max des voiles

; _iJourMin sortie triage jour max des voiles + dalles

; _bCache cache la somme des longueurs si nil

; _iDecCoff Début coffrage

; _iDurCoff Durée coffrage

; _iDecFerr Début ferraillage

; _iDurFerr Durée ferraillage

; _estDalle Resultat de estUnVoile : numéro de la polyligne

; _lBanches

; _lCaract

;

 

;;;;;COMMANDE AUTOCAD

 

(defun c:Phas_Voile (/)

(if (null _iJourCour) (Voile_Reinit))

(Voile_Cree)

)

 

(defun c:Phas_EdDAl (/)

(Dalle_Cree)

)

 

(defun c:Phas_Reinit (/)

(voile_choix)

)

 

(defun c:Phas_Select (/)

(Triage T)

(sssetfirst _ssVoil _ssVoil)

(if _bCache

(voile_compte)

(princ "\n Utiliser la commande PHAS_CACHE pour afficher les longueurs.")

)

(princ)

)

 

(defun c:Phas_Circl (/)

(Voile_Chng 0)

)

 

(defun c:Phas_Increm (/)

(Voile_Incr 1)

)

 

(defun c:Phas_Decrem (/)

(Voile_Incr -1)

)

 

(defun c:Phas_Xcrem (/)

(Voile_Incr 0)

)

 

(defun voile_choix (/ sRep)

(initget "D J L O")

(setq sRep (getkword "\nChoix de l'option [initialiser valeurs Defauts/choix Jour/bascule affichage Longueur/compte des Objets] <D> : "))

(if (not sRep) (setq sRep "D"))

(cond

((= sRep "D") (Voile_Reinit) (Init_Coff) (Dalle_Reinit))

((= sRep "J") (initget 1) (setq _iJourCour (1- (getint "\nJour de départ : "))))

((= sRep "L") (long_Cache))

((= sRep "O") (voile_compte) (textscr))

)

)

 

;;;Bascule longueur : affiche si caché et inversement

 

(defun long_Cache (/)

(if _bCache

(progn

(setq _bCache nil)

(princ "\n Cache les longueurs, Phas_Compte pour la somme.")

)

(progn

(setq _bCache T)

(princ "\n Affiche les longueurs cumulées pour chaque jours.")

)

)

(princ)

)

 

;;;;; Retourne n voiles trouvés + longueur

; triage doit déja être passé

 

(defun voile_compte (/ lstPass iParc iRes fTotal iPrefa iPoteau fTotal iNbj lElem)

(setq lstPass (Voil_List nil)

lstPass (vl-sort lstPass 'Voil_Tri)

iParc (car (car lstPass))

;iRes (ssname _ssVoil 0)

fTotal 0

iTotal 0

iNbj 0

iPrefa 0

iPoteau 0)

(if (> (length lstPass) 0)

(progn

(princ "\n------VERTICAUX------")

(foreach lElem lstPass

(if (= iParc (car lElem))

(if (estPrefa (cadr lElem)) (setq iPrefa (1+ iPrefa))

(if (estPoteau (cadr lElem)) (setq iPoteau (1+ iPoteau))

(setq fTotal (+ fTotal (longDe (cadr lElem)))

iTotal (1+ iTotal))))

(progn

(princ (strcat "\nJour " (itoa iParc) " : "

(if (> iTotal 0) (strcat (itoa (fix fTotal)) " pour " (itoa iTotal) " voile" (if (> iTotal 1) "s" "")) "")

(if (> iPoteau 0) (strcat ", " (itoa iPoteau) " poteau" (if (> iPoteau 1) "x" "")) "")

(if (> iPrefa 0) (strcat ", " (itoa iPrefa) " préfa" (if (> iPrefa 1) "s" "")) "")))

(setq iPrefa (if (estPrefa (cadr lElem)) 1 0)

iPoteau (if (estPoteau (cadr lElem)) 1 0)

iParc (car lElem))

(if (and (not (estPrefa (cadr lElem))) (not (estPoteau (cadr lElem))))

(setq fTotal (longDe (cadr lElem)) iTotal 1)

(setq fTotal 0 iTotal 0))

)

)

)

(princ (strcat "\nJour " (itoa iParc) " : "

(if (> iTotal 0) (strcat (itoa (fix fTotal)) " pour " (itoa iTotal) " voile" (if (> iTotal 1) "s" "")) "")

(if (> iPoteau 0) (strcat ", " (itoa iPoteau) " poteau" (if (> iPoteau 1) "x" "")) "")

(if (> iPrefa 0) (strcat ", " (itoa iPrefa) " préfa" (if (> iPrefa 1) "s" "")) "")))

)

)

(setq lstPass (Dall_List))

(setq iPrefa (vl-sort (car lstPass) 'Voil_Tri))

(if (> (length iPrefa) 0)

(progn

(princ "\n------COFFRAGE DALLES------")

(Surf_Compte iPrefa "coffrés")

))

(setq iPrefa (vl-sort (cadr lstPass) 'Voil_Tri))

(if (> (length iPrefa) 0)

(progn

(princ "\n------FERRAILLAGE DALLES------")

(Surf_Compte iPrefa "ferraillés")

))

(setq iPrefa (vl-sort (cddr lstPass) 'Voil_Tri))

(if (> (length iPrefa) 0)

(progn

(princ "\n------COULAGE DALLES------")

(Surf_Compte iPrefa "coulés")

))

(princ "\n")

(princ)

)

 

; affichage utilisé par voile_compte sur les dalles

(defun Surf_Compte (lListe sAction / iParc iTotal lElem fTotal)

(setq iParc (car (car lListe))

iTotal 0

fTotal 0)

(foreach lElem lListe

(if (= iParc (car lElem))

(setq fTotal (+ fTotal (surfDe (cadr lElem)))

iTotal (1+ iTotal))

(progn

(princ (strcat "\nJour " (itoa iParc) " : "

(if (> fTotal 0) (strcat (itoa (fix (/ fTotal 10000))) " m2 " sAction " sur "

(itoa iTotal) " plot" (if (> iTotal 1) "s" "")) "")))

(setq iParc (car lElem)

fTotal (surfDe (cadr lElem))

iTotal 1)

)

)

)

(princ (strcat "\nJour " (itoa iParc) " : "

(if (> fTotal 0) (strcat (itoa (fix (/ fTotal 10000))) " m2 " sAction " sur "

(itoa iTotal) " plot" (if (> iTotal 1) "s" "")) "")))

(princ)

)

 

;;;;;CREATION D'UN VOILE : SOLIDE + COTE + TEXTE + CERCLE

 

(defun Voile_Cree (/ pt_Dp pt_Ar pt_Ep pt_Pr iTmp bTest)

;(princ (strcat "\nJour précédent: " (itoa _iJourCour)))

(setq pt_Dp (getpoint "\nDébut du voile : ")) (setq pt_Ar (getpoint pt_Dp "\nFin du voile : "))

;(setq pt_Ep pt_Ar)

(setq pt_Ep (getpoint pt_Ar "\nEpaisseur : "))

(setq iTmp (getInt (strcat "\n<Jour précédent = " (itoa _iJourCour) "> Incrément(1): ")))

(if (null iTmp)

(setq iTmp 1)

)

(setq _iJourCour (+ _iJourCour iTmp))

(setq bTest (Voile_Dessin pt_Dp pt_Ar pt_Ep _iJourCour))

(if _bCache (Voile_Long _iJourCour nil))

(princ)

)

 

;;;;;CHOIX DU JOUR COURANT DE LA ROTATION

;

; Si le N° du premier jour n'est pas rentré un bloc

; est collé pour récupérer le style de côtes "EMETH_Rotation"

; qui est ensuite courant

;

 

(defun Voile_Reinit (/)

(setvar "INSUNITS" 5)

(setvar "INSUNITSDEFSOURCE" 5)

(setvar "INSUNITSDEFTARGET" 5)

(command "-inserer" (strcat (getenv "RepMeth") "\\e-methodes\\Phas_Voile\\Phas_JourBase.dwg") "0.0" "1" "1" "0")

(entdel (entlast))

(command "-style" "ARIAL" "" "" "" "" "" "")

(command "-cotstyle" "R" "EMET_Rotation")

(command "ecrangra")

(princ "\n Outils de phasage chargés")

(setq _iJourCour 0)

)

 

;;;;;PASSAGE D'UN VOILE A UN PREFA OU A UN POTEAU

;

; Change le texte de cote pour poteaux ou prefas

; Augmente le décallage coffrage + ferraillage pour une dalle

;

(defun Voile_Chng ( iNum / iJFrom iJour bRond obObj obText lText oldNum newNum oldCot iRes newTxt pt3 pt4 pt0 pt1 pt2 iEp lSolid obSolid)

(setq obObj (car (entsel)))

(while (/= obObj nil)

(setq iRes (EstUnVoile obObj))

;(if (/= iRes 0)

(if iRes

(progn

; Edition du texte

;(setq obText (handent (itoh (+ iRes 14))))

(setq obText (entnext (entnext (entnext iRes))))

(setq lText (entget obText))

(setq iJour (cdr (assoc 1 lText)))

(setq iJFrom (atoi iJour))

; Edition de la cote

;(setq obText (handent (itoh (+ iRes 1))))

(setq obText (entnext iRes))

(setq lText (entget obText))

(setq oldCot (assoc 1 lText))

(setq oldNum (substr (cdr oldCot) 1 2))

;3 possibilités :

; voiles : lg. = <>JOUR

; poteaux : pot EPx<>JOUR

; préfas : préfa <> pose JOUR

;parametre d'entréé :

; 0 => circulaire NON IMPLEMENTE

; 1 => voiles

; 2 => poteau

; 3 => préfa

(if (= iNum 0)

(if (wcmatch oldNum "lg")

(setq newNum 2)

(if (wcmatch oldNum "po")

(setq newNum 3)

(setq newNum 1)

)

)

(setq newNum iNum)

)

(if (= newNum 2)

(progn

;(setq lSolid (entget (handent (itoh iRes))))

(setq lSolid (entget iRes))

(setq pt3 (cdr (assoc 13 lText)))

(setq pt4 (cdr (assoc 14 lText)))

(setq iEp (epaisDe iRes))

)

)

(if (or (= newNum 3) (= newNum 1))

(progn

;(setq obSolid (handent (itoh iRes)))

(setq obSolid iRes)

(setq lSolid (entget obSolid))

(setq pt2 (assoc 12 lSolid))

(setq pt3 (assoc 13 lSolid))

(setq pt0 (cons 12 (cdr pt3)))

(setq pt1 (cons 13 (cdr pt2)))

(setq lSolid (subst pt0 pt2 lSolid))

(entmod lSolid)

(setq lSolid (entget obSolid))

(setq obSolid (subst pt1 pt3 lSolid))

(entmod obSolid)

)

)

(if (= newNum 1)

(setq newTxt (cons (car oldCot) (strcat "lg. = <>" iJour)))

(if (= newNum 2)

(setq newTxt (cons (car oldCot) (strcat "pot. " (rtos iEp 2 0) "x<>" iJour)))

(setq newTxt (cons (car oldCot) (strcat "préfa <>" iJour)))

)

)

(setq obText (subst newTxt oldCot lText))

(entmod obText)

(if _bCache (Voile_Long (jourDe iRes 0) nil))

)

(if _estDalle

(progn

(setq lSolid (entget (entnext _estDalle)))

;(setq lSolid (entget (entnext (car (entsel)))))

(setq oldCot (EditDalle lSolid))

(if oldCot

(progn

(setq newNum (fix (atof (car oldCot))))

(setq obText (list newNum))

(if (> (fix (atof (cadr oldCot))) 1)

(repeat (1- (fix (atof (cadr oldCot))))

(setq newNum (1+ newNum)

obText (cons newNum obText))

)

)

(setq newTxt (list (reverse obText)))

(setq newNum (fix (atof (caddr oldCot))))

(setq obText (list newNum))

(if (> (fix (atof (cadddr oldCot))) 1)

(repeat (1- (fix (atof (cadddr oldCot))))

(setq newNum (1+ newNum)

obText (cons newNum obText))

)

)

(setq newTxt (cons (reverse obText) newTxt)

newTxt (cons (jourDe _estDalle 0) newTxt)

newTxt (cons 1 (getCoteDalle (reverse newTxt)))

lSolid (subst newTxt (assoc 1 lSolid) lSolid))

(entmod lSolid)

)

)

(setq _estDalle (DalleChech _estDalle))

)

(princ "\nObjet invalide")

)

)

(setq obObj (car (entsel)))

)

)

 

;;;;;CHANGEMENT DE JOUR

;

; Utilisé en +1 -1 ou en +/-n

; 0 pour projection sur un jour

;

(defun Voile_Incr ( iNum / obObj obText lText oldNum newNum oldCot iRes iPosIt iProj iJFrom iJTo estVoile)

(setq obObj (car (entsel)))

(while (/= obObj nil)

(setq iRes (EstUnVoile obObj))

(if iRes

(setq estVoile T)

(setq iRes (DalleChech _estDalle)

estVoile nil)

)

;(if (/= iRes 0)

(if iRes

(progn

(if (= iNum 0)

(if (not iProj)

(progn

(setq iNum (getint "\nDécalage (0 pour projection) : "))

(if (= iNum 0)

(setq iProj (getint "\nJour de projection : "))

(setq iProj Nil)

)

)

)

)

; Edition de la cote

(setq obText (entnext iRes))

(setq lText (entget obText))

(setq oldCot (assoc 1 lText))

(if estVoile

(setq iPosIt (vl-string-position (ascii ">") (cdr oldCot)))

(setq iPosIt (1+ (vl-string-position (ascii ":") (cdr oldCot) 0 T)))

)

(setq iJFrom (atoi (substr (cdr oldCot) (+ 2 iPosIt))))

(if (= iNum 0)

(setq iJTo iProj)

(setq iJTo (+ iNum iJFrom))

)

; iJFrom et iJTo acquis

(if estVoile

(setq newNum (cons (car oldCot) (strcat (substr (cdr oldCot) 1 (+ 1 iPosIt)) (itoa iJTo))))

(setq newNum (cons 1 (getCoteDalle (addListDalle (getListeDalle (cdr oldCot)) (- iJTo iJFrom)))))

)

(setq obText (subst newNum oldCot lText))

(entmod obText)

(setq obText iRes)

(if estVoile

(progn

; Edition du texte

(setq obText (entnext (entnext (entnext iRes))))

(setq lText (entget obText))

(setq oldNum (assoc 1 lText))

(setq newNum (cons (car oldNum) (itoa iJTo)))

(setq obText (subst newNum oldNum lText))

(entmod obText)

)

; Change couleur de la hachure

(Change_Couleur iJTo (entnext (entnext iRes)))

)

(Change_Couleur iJTo iRes)

(if (and _bCache estVoile) (Voile_Long iJFrom iJTo))

)

(princ "\nObjet invalide")

)

(setq obObj (car (entsel)))

)

)

 

(defun testCoul (/)

(setq iJour 0)

(while (< iJour 256)

(command "copier" oCoule "" "0,0" sDist)

(Change_Couleur iJour oCoule)

(setq oCoule (entlast))

(setq iJour (+ iJour 1))

)

)

 

(defun getCPLine (/ oBase pt_Ar pt_Ep lLignes pt_Or)

(setq pt_Ep (getpoint "\nPremier point : ")

pt_First pt_Ep)

(initget 32 "u r")

(setq pt_Ar (getpoint pt_Ep "\nPoint suivant [annUler ou Rectangle] <R> : "))

(if (not pt_Ar) (setq pt_Ar "R"))

(if (or (= pt_Ar "r") (= pt_Ar "R"))

(progn

(initget (+ 32 7))

(setq pt_Ar (getpoint pt_Ep "\nDiagonale du rectangle : "))

(setq pt_Or (list (car pt_Ar) (cadr pt_Ep) (caddr pt_Ep)))

(command "_line" pt_Ep pt_Or "")

(command "_pedit" (entlast) "" "")

(setq oBase (entlast))

(command "_line" pt_Or pt_Ar "")

(command "_join" oBase (entlast) "")

(setq pt_Or (list (car pt_Ep) (cadr pt_Ar) (caddr pt_Ep)))

(command "_line" pt_Ar pt_Or "")

(command "_join" oBase (entlast) "")

(command "_pedit" oBase "c" "")

oBase

)

(progn

(setq pt_Ar (list (car pt_Ar) (cadr pt_Ar) (caddr pt_Ep))

pt_Or pt_Ar)

(command "_line" pt_Ep pt_Ar "")

(command "_pedit" (entlast) "" "")

(setq oBase (entlast))

(setq lLignes (list))

(while pt_Ar

(initget 32 "u c s")

(setq pt_Ep (getpoint pt_Ar "\nPoint suivant [annUler, Symétrique ou Clore] <C> : "))

(if (not pt_Ep) (setq pt_Ep "C"))

(cond

((or (= pt_Ep "u") (= pt_Ep "U")) (if (> (length lLignes) 0)

(progn

(command "_erase" (car lLignes) "")

(setq lLignes (cdr lLignes))

(if (> (length lLignes) 0)

(setq pt_Ar (cdr (assoc 10 (entget (car lLignes)))))

(setq pt_Ar pt_Or)

)

)

(princ "\nImpossible d'annuler")))

((or (= pt_Ep "c") (= pt_Ep "C")) (if (> (length lLignes) 0) (setq pt_Ar nil) (princ "\nImpossible de clore")))

((or (= pt_Ep "s") (= pt_Ep "S")) (progn

(foreach pt_Ep lLignes

(command "_mirror" pt_Ep "" pt_First pt_Ar "N")

(setq lLignes (cons (entlast) lLignes))

)

(setq pt_Ar nil)

))

(T (progn

(setq pt_Ep (list (car pt_Ep) (cadr pt_Ep) (caddr pt_Ar)))

(command "_line" pt_Ep pt_Ar "")

(setq lLignes (cons (entlast) lLignes)

pt_Ar pt_Ep)))

)

)

(foreach pt_Ar (reverse lLignes)

(command "_join" oBase pt_Ar "")

)

(command "_pedit" oBase "c" "")

oBase

)

)

)

 

(defun getLongDiag (oPLine / lPLine lPoints ePTDep ePTArr lDist ptTheDiag dDist bMaj)

;(setq oPLine (getCPLine))

(setq lPLine (entget oPLine))

(setq lPoints (list))

(while lPLine

(setq lPLine (cdr lPLine))

(if (= (car (car lPLine)) 10)

(setq lPoints (cons (cdr (car lPLine)) lPoints))

)

)

(setq lDist (list)) ; boucle sur TOUT les éléments => 2 x fois trop de test

(foreach ePTDep lPoints

(foreach ePTArr lPoints

(setq bMaj 0)

(setq dDist (distance ePTDep ePTArr))

(foreach eDist lDist (if (> dDist eDist) (setq bMaj (1+ bMaj))))

(if (>= bMaj (length lDist))

(setq lDist (cons dDist lDist)

ptTheDiag (list ePTArr)

ptTheDiag (cons ePTDep ptTheDiag))

)

)

)

ptTheDiag

)

 

(defun Dalle_Reinit (/ lTmp)

(if (not _iJourCour) (Voile_Reinit))

(setq lTmp (EditDalle nil))

(if lTmp

(setq _iDecCoff (fix (atof (car lTmp)))

_iDurCoff (fix (atof (cadr lTmp)))

_iDecFerr (fix (atof (caddr lTmp)))

_iDurFerr (fix (atof (cadddr lTmp)))

)

)

)

 

; Objets crees doivent etre DANS CET ORDRE : HATCH DIMENSION LWPOLYLINE

; pour supporter d'etre recopiés par autocad

(defun Dalle_Cree (/ oObj oCot iTmp ptDiag)

(if (not _iDecCoff) (dalle_reinit))

(setvar "CECOLOR" "ROUGE")

(setq oObj (getCPLine))

(print (strcat "Surface du plot : " (rtos (/ (vlax-get-property (vlax-ename->vla-object oObj) 'AREA) 10000)) "m²"))

(setq iTmp (getInt (strcat "\n<Jour précédent = " (itoa _iJourCour) "> Incrément(1): ")))

(if (null iTmp)

(setq iTmp 1)

)

(setvar "CECOLOR" "DUCALQUE")

(setq _iJourCour (+ _iJourCour iTmp))

(setq ptDiag (getLongDiag oObj))

(command "dimaligned" (car ptDiag) (cadr ptDiag) "te" (getCoteDalle (getListeDalle _iJourCour)) (cadr ptDiag))

(DalleGetHatch (entlast) oObj _iJourCour)

)

 

;construit le retour de la boite de dialogue

(defun ValeurDial (bDec /)

(if (not bDec)

(list (get_tile "DacCo") (get_tile "DurCo") (get_tile "DacFe") (get_tile "DurFe"))

(list (get_tile "DebCo") (get_tile "DurCo") (get_tile "DebFe") (get_tile "DurFe"))

)

)

 

; Boîte de dialogue jours de dalles

; oCote est la ligne de cotation de la dalle

 

(Defun EditDalle (oCote / lJours lResult)

(new_dialog "JoursDalle" (load_dialog (findfile (strcat (getenv "RepMeth") "\\e-methodes\\Phas_Voile\\Phas_EdDal.dcl"))))

(if oCote

(progn

(setq lJours (getListeDalle (cdr (assoc 1 oCote))))

(set_tile "DebCo" (itoa (car (car lJours))))

(set_tile "DacCo" (itoa (- (caddr lJours) (car (car lJours)))))

(set_tile "DurCo" (itoa (length (car lJours))))

(set_tile "DebFe" (itoa (car (cadr lJours))))

(set_tile "DacFe" (itoa (- (caddr lJours) (car (cadr lJours)))))

(set_tile "DurFe" (itoa (length (cadr lJours))))

(set_tile "JCoul" (strcat "Coulage en jour " (itoa (caddr lJours))))

(mode_tile "DacCo" 1)

(mode_tile "DacFe" 1)

(action_tile "valide" "(setq lResult (ValeurDial T))(done_dialog 1)")

)

(progn

(if (not _iDecCoff) (setq _iDecCoff 2))

(if (not _iDurCoff) (setq _iDurCoff 1))

(if (not _iDecFerr) (setq _iDecFerr 1))

(if (not _iDurFerr) (setq _iDurFerr 1))

(set_tile "DebCo" (strcat "n - " (itoa _iDecCoff)))

(set_tile "DacCo" (itoa _iDecCoff))

(set_tile "DurCo" (itoa _iDurCoff))

(set_tile "DebFe" (strcat "n - " (itoa _iDecFerr)))

(set_tile "DacFe" (itoa _iDecFerr))

(set_tile "DurFe" (itoa _iDurFerr))

(set_tile "JCoul" "Coulage en jour n")

(mode_tile "DebCo" 1)

(mode_tile "DebFe" 1)

(action_tile "valide" "(setq lResult (ValeurDial nil))(done_dialog 1)")

)

)

(if (= (start_dialog) 1)

lResult

nil)

)