Aller au contenu

bonuscad

Membres
  • Compteur de contenus

    5 029
  • Inscription

  • Dernière visite

  • Jours gagnés

    56

Tout ce qui a été posté par bonuscad

  1. bonuscad

    Limitation de ....

    Oui, effectivement je ralenti... :o Mais le problème, c'est que si une pauvre mémé traverse la route, elle risque de se retrouver sur mon capot par manque d'attention. Bon d'accord elle sera pas tué car je risque d'être au pas, mais ça fera quand même un blessé. :casstet: Faut pas grand chose pour me distraire :P
  2. bonuscad

    LISP AUTOCAD

    Le suivant vient d'un forum anglais (je l'ai traduit) Une recherche avec google avec le mot "vplockall" m'a retourné d'autres routines sur le forum autodesk très similaires mais pas celle-là, désolé pour l'auteur :( (certaines mettent même une couleur verte ou rouge à la fenêtre suivant si elle est verrouillé ou non) Voilà si celle-ci ne te plait pas, tu as le choix en faisant des recherches... on va pas réécrire ce qui a déjà été écrit plusieurs fois. :exclam: (defun c:vplockall ( / X lck prmpt ent) (vl-load-com) (initget 0 "Verrouiller Deverrouiller _Lock Unlock") (if (not *default*)(setq *default* "Lock")) (setq X (cond ((getkword (strcat "\n [Verrouiller/Deverrouiller] toutes les fenêtres? <" *default* ">: "))) (*default*))) (setq *default* X) (cond ((= X "Lock") (setq lck :vlax-true prmpt "verrouillées...") ) ((= X "Unlock") (setq lck :vlax-false prmpt "déverrouillées...") ) ) (vlax-for lay (vla-get-layouts (vla-get-activedocument (vlax-get-acad-object) ) ) (if (eq :vlax-false (vla-get-modeltype lay)) (vlax-for ent (vla-get-block lay) ; for each ent in layout (if (= (vla-get-objectname ent) "AcDbViewport") (vla-put-displaylocked ent lck) ) ) ) ) (princ (strcat "\n Toutes les fenêtres ont été " prmpt)) (princ) )
  3. Regarde ICI , le lien est encore valide, je viens de le vérifier. Tu trouveras le lisp zebra dans l'archive (et bien d'autres). Ayant changé d'actiivité, (je ne fais plus d'études routière, mais du SIG sur un département entier), ceci me prends énormément de temps et me met en "standby" sur le développement ou amélioration de ce que j'ai pu faire jusqu'à maintenant. NB: Conseil si tu veux utiliser l'ensemble, mets tout dans un même dossier et rajoutes le dans les chemins de recherche d'Autocad. Tu peux intervenir dans le fichier MNL et dans le fichier fixvar.lsp, car ceux ci peuvent ne pas répondre à tes habitudes de travail et constituer un environnement indésirable pour toi si tu utilises le menu fourni. Tu peux bidouiller le menu pour ne garder que l'essentiel pour toi, si le coeur t'en dit ;) Voila c'est tel quel et j'espère que cela te rendra service sans trop de bugs...
  4. bonuscad

    ORTHO

    Par défaut ^O pour bascule mode "Ortho" Il peut être redéfini déjà en ^L dans la section "ACCELERATOR" Pour "accroche objet" normalement ^B par défaut, mais peut être redéfini en ^F. Donc difficile de donner la réponse précise vu que tout cela est redéfini, soit par AutoDesk, soit par l'utilisateur Il ne te reste plus qu'a essayer tout les combinaisons possibles si celles que j'ai données ne donne rien. NB:^B = [Control]+
  5. (entmake) est intéressant car on peut directement mettre la copie dans un nouveau calque, mais il faut traiter les "INSERT" et les anciennes "POLYLINE" On pourrait faire ceci: (defun Entsel_Getstring ( / ent key kstr) (setq kstr nil ent "") (princ "\nSélectionnez un objet / Entrez un nom de calque: ") (while (and (not (equal (setq key (grread T 4 2)) '(2 13))) (/= (car key) 3)) (if (eq (car key) 2) (if (eq (cadr key) 8) (progn (princ (chr 8)) (princ (chr 32)) (princ (chr 8)) (setq kstr (cdr kstr)) ) (progn (setq kstr (cons (cadr key) kstr)) (princ (chr (cadr key))) ) ) ) ) (if (eq (car key) 3) (if (setq ent (nentselp (cadr key))) (setq ent (cdr (assoc 8 (entget (car ent))))) (progn (princ "\nSélection vide!") (setq ent nil) (entsel_getstring)) ) (progn (foreach n kstr (setq ent (strcat (chr n) ent))) (if (or (eq ent "") (wcmatch ent "*[<>`?`,;:/`*\"|``\\=]*")) (progn (princ "\nEntrée invalide!") (entsel_getstring)) ent ) ) ) ) (defun c:dupliquer ( / to_lay js dxf_ent n dxf_nent) (setq js (ssget)) (cond (js (setq nam_lay (entsel_getstring)) (setq n -1) (repeat (sslength js) (setq dxf_ent (entget (ssname js (setq n (1+ n))))) (setq dxf_ent (subst (cons 8 nam_lay) (assoc 8 dxf_ent) dxf_ent)) (entmake dxf_ent) (if (member (cdr (assoc 0 dxf_ent)) '("INSERT" "POLYLINE")) (progn (setq dxf_nent (entget (entnext (cdar dxf_ent)))) (while (/= (cdr (assoc 0 dxf_nent)) "SEQEND") (setq dxf_nent (subst (cons 8 nam_lay) (assoc 8 dxf_nent) dxf_nent)) (entmake dxf_nent) (setq dxf_nent (entget (entnext (cdar dxf_nent)))) ) (entmake dxf_nent) ) ) ) (princ (strcat "\n" (itoa (1+ n)) " objet(s) dupliqué(s) sur le calque \"" nam_lay "\"")) ) ) (prin1) ) (entsel_getstring) n'est pas nécessaire, je l'ai rajouté pour le confort d'utilisation pour la saisie du nom du calque. D'ailleurs si on pointe un bloc pour la référence du calque, c'est le calque de la sous-entité qui est récupéré. Inconvénient de (nentselp) :(
  6. Regarde cette réponse , elle peut (peut être) t'aider... Elle suit les recommendations de la signalisation routière. Si tu as des zébras à mettre en place, j'ai aussi une routine, un peu plus ardue à utiliser et moins fiable sur l'execution.
  7. bonuscad

    dce

    J' abonde dans le sens de Thierry, Le cahier des profils en travers est inutile à ce stade. Une vérification "à la louche" du détail estimatif, pourra être faite avec le profil type et le profil en long si l'entreprise a un doute sur le quantitatif. Une coquille quoi :P
  8. Je ne sais pas si j'ai vraiment saisi ton désir, mais en utilisant ce qui était proposé dans ce SUJET et en l'utilisant conjointement avec le lisp de Patrick_35 ?
  9. bonuscad

    Grouper / Degrouper

    Je ne sais pas si il n'y a pas confusion..... Je n'ai pas compilé mes sources, et ce que j'ai pu écrire ne s'appelle pas ainsi. Ce que j'ai pu fournir et ceci, je ne sais pas si c'est la même chose dont parle jf ! :exclam: (defun c:degroup ( / ent dxf_ent dxf_def dxf_grp lst lst_name_gr ent_grp) (while (null (setq ent (entsel)))) (setq dxf_ent (entget (car ent))) (setq dxf_def (entget (cdr (assoc 330 dxf_ent)))) (cond ((eq (cdr (assoc 100 dxf_def)) "AcDbGroup") (setq dxf_grp (dictsearch (namedobjdict) "ACAD_GROUP") lst (member (cons 350 (cdar dxf_def)) (reverse dxf_grp)) nam_gr (list (cadr lst) (car lst)) ent_grp (dictsearch (cdr (assoc -1 dxf_grp)) (cdar nam_gr)) ) (entdel (cdar ent_grp)) (princ "\nEntités dégroupées") ) (T (princ "\nEntité non groupée") ) ) (princ) ) (defun c:regroup ( / js) (setq js (ssget)) (cond (js (setvar "cmdecho" 0) (command "_.-group" "_create" "*" "" js "") (setvar "cmdecho" 1) (princ "\nGroupe créé.") ) (princ "\nAucune sélection.") ) (princ) ) (princ "\nCommande REGROUP/DEGROUP")(princ)
  10. On t'avais bien conseillé ;) En effet pendant un certain temps, et sous certaine version et plateforme (version d'OS), cela posait parfois des problèmes. Ils peut y en avoir encore, mais je penses que l'on peut utiliser (avec parcimonie, et plutôt pour de la présentation et non pour de la cotation ou attribut) des polices True Type avec beaucoup de confiance. Les polices SHX sont un résidu des versions DOS qui sont conservées pour des histoires de compatibilité avec d'anciens dessins par exemple. Elles ont quand même l'avantage de peser moins lourds dans un dessin (C'est pour ça que je dis d'utiliser les TTF avec parcimonie) ;) Mais l'utilisation des TrueType ne peux que se généraliser, il ne faut pas se leurrer. Il faut admettre qu'il y a plus de choix dans celles ci que dans les SHX pour faire des écritures. Il peut persister quand même un problème à l'impression suivant les drivers du périphérique de traçage (périphérique ancien) A toi de voir maintenant si tu peux te permettre de les utiliser, moi je pense que oui.
  11. bonuscad

    polyligne 3d avec arc

    Tout à fait ! :P Moi par exemple, j'aurais été incapable de calculer le balancement d'un escalier, car ce n'est pas mon domaine. J'aurais fait certainement quelque chose "d'approximatif". Ma réponse etait plutôt une "boutade", cela n'enlève en rien les connaissances en géomètrie de Gilles, que je félicite pour toutes ses réponses pertinantes. Ne solicitez pas trop ce brave garçon, vous allez finir par le blaser! :exclam: Il mérite mieux que d'être au chomage avec ses qualités. :(
  12. bonuscad

    polyligne 3d avec arc

    Gilles, juste quelque infos sur l'interpolation! Il y a plusieurs méthode: La plus simple: Pour interpoler un point sur un segment curviligne entre 2 points connus en Z. Il faut utiliser la longueur curviligne en 2D entre ces 2 points et non la distance rectiligne entre ces 2 points. Après tu fais simplement une règle de trois pour obtenir le Z à la distance curviligne du point désiré. L'autre méthode est plus complexe et généralement utilisé pour une interpolation sur des élément de type triangle 3D (MNT) ou on considère le poids du point. Les points utilisés ont plus de poids s'ils sont sont proches du point recherché (il y a des formules pour ça). Donc plus le point connu est proche du point recherché, plus sont influence pour l'interpolation pèse pour le calcul. Je pense que ceci expliquera la différence de temps d'éxecution entre COVADIS et ton lisp Tout ceci sort du domaine de l'ébénisterie ou menuiserie ;)
  13. Le voici modifié, il fonctionne avec un bloc prédéfini à l'avance et qui se nomme BLK2END. (defun c:blk2end ( / js n name_blk obj dxf_obj obj_vlax pt1_start pt2_start par pt1_end pt2_end dxf_210) (defun z_dir (p1 p2 / ) (trans '(0.0 1.0 0.0) (mapcar '(lambda (k) (/ k (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) (mapcar '- p2 p1) ) ) ) ) ) (mapcar '- p2 p1) ) 0 ) ) (setq js (ssget "_x" '((0 . "LWPOLYLINE"))) n -1 name_blk "blk2end") (repeat (sslength js) (setq obj (ssname js (setq n (1+ n)))) (cond ((or (eq (cdr (assoc 0 (setq dxf_obj (entget obj)))) "LWPOLYLINE") (and (eq (cdr (assoc 0 dxf_obj)) "POLYLINE") (zerop (boole 1 112 (cdr (assoc 70 dxf_obj)))) ) ) (vl-load-com) (setq obj_vlax (vlax-ename->vla-object obj) pt1_start (vlax-curve-getStartPoint obj_vlax) pt1_end (vlax-curve-getEndPoint obj_vlax) par (vlax-curve-getParamAtPoint obj_vlax pt1_end) ) (cond ((not (zerop par)) (setq pt2_start (vlax-curve-getPointAtParam obj_vlax 1) pt2_end (vlax-curve-getPointAtParam obj_vlax (1- par)) ) (foreach n (list (list pt1_start pt2_start) ) (setq dxf_210 (z_dir (car n) (cadr n))) (entmake (list (cons 0 "INSERT") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (cons 8 (getvar "CLAYER")) (cons 100 "AcDbBlockReference") (cons 2 name_blk) (cons 10 (trans (car n) 0 dxf_210)) (cons 50 (angle (trans (car n) 0 dxf_210) (trans (cadr n) 0 dxf_210))) (cons 210 dxf_210) ) ) ) ) ) ) (T (princ "\nIsn't 2Dpolyline avalaible for this function!") ) ) ) (prin1) )
  14. Je te laisse traduire et corriger la syntaxe pour le language international, Une fois adapté, il à l'air de bien faire ce que tu désire. Voir PARABEL.lsp dans MARVOLISP.ZIP Des explications plus détaillées dans ta question seraient bien venues. Tu travailles tes profils en long en échelle déformé ou pas ? En échelle déformé de 1 pour 10, on accepte de travailler avec des arcs pour représenter les paraboles, l'erreur est infime. Si tu veux utiliser les paraboles il faut travailler en échelle non-déformée.
  15. bonuscad

    c`est un peu contour ca

    La fonction (bpoly), bien que fonctionnant en ligne de commande, n'est pas du tout documentée. En m'appuyant sur des infos fourni en V12, j'ai pu retrouver la syntaxe d'appel pour cette fonction. (bpoly [pt interieur] [nil/T] [vecteur] [jeu sélection]) Je n'ai pas compris à quoi servait [nil/T], et pour le vecteur je pense que c'est le vecteur de direction? En lisp cela pourrait donné ceci pour faire la même chose que Pieroka, mais sans les boites de dialogue. ((lambda ( / pt js e_last js_bp) (setq js_bp (ssadd)) (while (setq pt (getpoint "\nPoint dans la zone: ")) (princ "\nChoix des objets pour la recherche du contour.") (setq js (ssget)) (cond (js (setq e_last (bpoly pt nil '(0 0 1) js)) (if e_last (setq js_bp (ssadd e_last js_bp))) ) ) ) (sssetfirst nil js_bp) (prin1) )) Si d'autres ont des infos plus explicatives sur cette fonction, je suis preneur ;)
  16. ICI J'ai mis en rouge les entités non traitées (lignes), seule les polyignes ont été modifiées pour recontruire les flèches identique à un rappel de cotation. Le bloc utilisé s'appelle "BLK2END". NB: J'ai modifié un peu la routine pour ton dessin (bloc à une seule extrémité et traitement sur l'ensemble des polyligne au lieu d'une séléction 1 par 1) Y reste plus qu'a convaincre ton "Boss" pour une version pleine. Car ce genre de traitement est aisée avec un peu de programmation.
  17. Une routine que j'ai proposé sur un forum US. Il te faudra faire au préalable un bloc qui représentera la flèche aux extrémités de la polyligne. (defun c:blk2end ( / obj dxf_obj obj_vlax pt1_start pt2_start par pt1_end pt2_end dxf_210) (defun z_dir (p1 p2 / ) (trans '(0.0 1.0 0.0) (mapcar '(lambda (k) (/ k (sqrt (apply '+ (mapcar '(lambda (x) (* x x)) (mapcar '- p2 p1) ) ) ) ) ) (mapcar '- p2 p1) ) 0 ) ) (while (not (setq obj (entsel "\nSelect a polyline: ")))) (cond ((or (eq (cdr (assoc 0 (setq dxf_obj (entget (car obj))))) "LWPOLYLINE") (and (eq (cdr (assoc 0 dxf_obj)) "POLYLINE") (zerop (boole 1 112 (cdr (assoc 70 dxf_obj)))) ) ) (vl-load-com) (setq obj_vlax (vlax-ename->vla-object (car obj)) pt1_start (vlax-curve-getStartPoint obj_vlax) pt1_end (vlax-curve-getEndPoint obj_vlax) par (vlax-curve-getParamAtPoint obj_vlax pt1_end) ) (cond ((not (zerop par)) (setq pt2_start (vlax-curve-getPointAtParam obj_vlax 1) pt2_end (vlax-curve-getPointAtParam obj_vlax (1- par)) ) (while (not (tblsearch "BLOCK" (setq name_blk (getstring "\nName of block: " T)))) (princ "\n ** incorrect name block! **") ) (foreach n (list (list pt1_start pt2_start) (list pt1_end pt2_end)) (setq dxf_210 (z_dir (car n) (cadr n))) (entmake (list (cons 0 "INSERT") (cons 100 "AcDbEntity") (assoc 67 dxf_obj) (assoc 410 dxf_obj) (cons 8 (getvar "CLAYER")) (cons 100 "AcDbBlockReference") (cons 2 name_blk) (cons 10 (trans (car n) 0 dxf_210)) (cons 50 (angle (trans (car n) 0 dxf_210) (trans (cadr n) 0 dxf_210))) (cons 210 dxf_210) ) ) ) ) ) ) (T (princ "\nIsn't 2Dpolyline avalaible for this function!") ) ) (prin1) )
  18. bonuscad

    Transformer bloc en wbloc

    Voir ce SUJET
  19. C'est juste une béquille pour pouvoir dessiner un raccordement progressif. Elle a ses limitations (calcule de factorielle selon la méthode de Fresnel), donc un raccordement s'enroulant sur lui même (type escargot) ne pourra être calculé (perte de précision). Un raccordement routier classique doit pouvoir se faire sans problème. (defun factor (y / ) (cond ((= 0 y) 1) (t (* y (factor (1- y)))) ) ) (defun fact (nbr / x) (setq x nbr) (factor (float x)) ) (defun serie (rep / mark rp resul) (setq mark 1 rp rep som 0 ) (repeat (fix (* l 10)) (setq resul (/ (expt tau rp) (* (1+ (* 2 rp)) (fact rp)))) (if (/= (rem mark 2) 0) (setq resul (- resul)) ) (setq som (+ resul som) rp (+ rp 2) mark (1+ mark) ) ) ) (defun cloun (l / k som) (setq r (/ 1 l) tau (/ l (* 2 r)) k (sqrt (* 2 tau)) ) (serie 2) (setq x (* k (+ 1 som))) (serie 3) (setq y (* k (+ (/ tau 3) som)) xm (- x (* r (sin tau))) ym (+ y (* r (cos tau))) dltr (- ym r) ) ) (defun matrix (pt / t_x t_y t_z t_v t_zo nw_x nw_y nw_z) (setq t_x (trans '(1 0 0) 0 1 T) t_y (trans '(0 1 0) 0 1 T) t_z (trans '(0 0 1) 0 1 T) t_v (trans '(0 0 0) 1 0) t_zo (trans '(0 0 0) 0 1) ) (setq nw_x (+ (* (car pt) (car t_x)) (* (cadr pt) (cadr t_x)) (* (caddr pt) (caddr t_x)) (car t_v) ) ) (setq nw_y (+ (* (car pt) (car t_y)) (* (cadr pt) (cadr t_y)) (* (caddr pt) (caddr t_y)) (cadr t_v) ) ) (setq nw_z (+ (* (car pt) (car t_z)) (* (cadr pt) (cadr t_z)) (* (caddr pt) (caddr t_z)) (caddr t_v) ) ) (list nw_x nw_y nw_z) ) (defun c:clothoide ( / d ent_d c ent_c dxf_10 dxf_11 dxf_r dxf_m dxf_g pt_per dxf_ym dxf_dltr lg_clo a_clo l_u lst_r cnt tstd tstl choix p_inf resol_cl l x y xm ym r tau dltr lst_som ) (if (= (getvar "worlducs") 1) (progn (setvar "cmdecho" 0) (setvar "blipmode" 0) (setvar "orthomode" 0) (setvar "osmode" (+ 16384 (rem (getvar "osmode") 16384))) (if (= (getvar "limcheck") 1) (setvar "limcheck" 0)) (command "_.undo" "_control" "_all") (command "_.undo" "_group") (while (not (setq d (nentsel"\nChoix de la droite: ")))) (setq ent_d (entget (car d))) (cond ((and (equal (assoc 210 ent_d) '(210 0.0 0.0 1.0)) (eq (cdr (assoc 0 ent_d)) "LINE")) (while (not (setq c (nentsel"\nChoix du cercle: ")))) (setq ent_c (entget (car c))) (cond ((and (equal (assoc 210 ent_c) '(210 0.0 0.0 1.0)) (or (eq (cdr (assoc 0 ent_c)) "CIRCLE") (eq (cdr (assoc 0 ent_c)) "ARC"))) (setq dxf_10 (trans (cdr (assoc 10 ent_d)) 1 0) dxf_11 (trans (cdr (assoc 11 ent_d)) 1 0) dxf_r (cdr (assoc 40 ent_c)) dxf_m (trans (cdr (assoc 10 ent_c)) 1 0) dxf_g (angle dxf_10 dxf_11) pt_per (inters (list (car dxf_10) (cadr dxf_10)) (list (car dxf_11) (cadr dxf_11)) (list (car dxf_m) (cadr dxf_m)) (list (car (polar dxf_m (+ (/ pi 2) dxf_g) dxf_r)) (cadr (polar dxf_m (+ (/ pi 2) dxf_g) dxf_r)) ) nil ) dxf_ym (distance dxf_m pt_per) dxf_dltr (- dxf_ym dxf_r) ) (cond ((and (not (minusp dxf_dltr)) (<= dxf_dltr (* 4.0 dxf_r))) (setq lg_clo (sqrt (+ (* 24 dxf_dltr dxf_r) (* 6 (expt dxf_dltr 2)))) a_clo (sqrt (* lg_clo dxf_r)) ) (setq l_u (/ lg_clo a_clo)) (cond ((<= l_u (* 4 (sqrt pi))) (cloun l_u) (setq lst_r (mapcar '(lambda (ww) (* ww a_clo)) (list x y xm ym dltr))) ;(prompt "\nErreur commise sur Delta R (en m.) = ") (prin1 (abs (- dxf_dltr (last lst_r)))) ;(prompt "\nDelta R reel : ") (prin1 (rtos dxf_dltr 2 5)) ;(prompt "\nDelta R calcule : ") (prin1 (rtos (last lst_r) 2 5)) (setq cnt 0) (while (not (equal (last lst_r) dxf_dltr 0.00001)) (setq cnt (1+ cnt)) (if (= (rem (1+ cnt) 2) 0) (setq tstd (last lst_r) tstl lg_clo) ) (if (= (rem cnt 2) 0) (setq lg_clo (* (/ dxf_dltr (/ (+ tstd (last lst_r)) 2)) (/ (+ lg_clo tstl) 2))) (setq lg_clo (* (/ dxf_dltr (last lst_r)) lg_clo)) ) (setq a_clo (sqrt (* lg_clo dxf_r))) (setq l_u (/ lg_clo a_clo)) (cloun l_u) (setq lst_r (mapcar '(lambda (ww) (* ww a_clo)) (list x y xm ym dltr))) ;(prompt "\nDelta R calcule : ") (prin1 (rtos (last lst_r) 2 5)) ) (setq choix (mapcar '(lambda (ww) (polar pt_per ww (caddr lst_r))) (list dxf_g (+ pi dxf_g)))) (if (> (distance (car choix) (cadr d)) (distance (cadr choix) (cadr d))) (setq dxf_g (+ pi dxf_g)) ) (setq p_inf (polar pt_per dxf_g (caddr lst_r)) dxf_g (+ pi dxf_g) ) (prompt (strcat "\nPas de résolution de la clothoïde <" (rtos (* 0.1 (sqrt lg_clo)) 2) "> :" ) ) (initget 6) (setq resol_cl (getdist)) (if (not resol_cl) (setq resol_cl (* 0.1 (sqrt lg_clo)))) (command "_.ucs" "_new" "_3point" p_inf pt_per dxf_m) (setq lst_som (list (matrix (list (car lst_r) (cadr lst_r) 0.0))) l (- lg_clo resol_cl)) (while (> l 0.0) (cloun (/ l a_clo)) (setq lst_som (cons (matrix (list (* x a_clo) (* y a_clo) 0.0)) lst_som) l (- l resol_cl)) ) (setq lst_som (cons (trans (list 0.0 0.0 0.0) 1 0) lst_som)) (command "_.ucs" "_world") (if (null (tblsearch "appid" "ID_CLOTHOIDE-BONUSCAD$2002")) (regapp "ID_CLOTHOIDE-BONUSCAD$2002") ) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") (cons 8 (getvar "CLAYER")) '(100 . "AcDbPolyline") (cons 90 (length lst_som)) ) (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) lst_som) (list (list -3 (list "ID_CLOTHOIDE-BONUSCAD$2002" (cons 1000 "ID_CLOTHOIDE") (cons 1002 "{") (cons 1040 dxf_g) (cons 1010 p_inf) (cons 1040 a_clo) (cons 1040 dxf_dltr) (cons 1040 tau) (cons 1040 lg_clo) (cons 1040 dxf_r) (cons 1010 dxf_m) (cons 1010 (matrix (list (car lst_r) (cadr lst_r) 0.0))) (cons 1002 "}") ) ) ) ) ) (command "_.undo" "_end") (alert (strcat "\nLES ANGLES SONT EXPRIME DANS LES UNITES UTILISES" "\n______________________________" "\nOrientation de l'infini\t: " (angtos dxf_g (getvar "aunits") 4) "\nOrigine clothoïde \t: X= " (rtos (car p_inf) 2 3) " Y= " (rtos (cadr p_inf) 2 3) "\n Rayon a l'origine \t: ...infini..." "\n Parametre A \t: " (rtos a_clo 2 3) "\n Delta R \t: " (rtos dxf_dltr 2 3) "\n Angle TAU \t: " (angtos tau (getvar "aunits") 4) "\n Developpement \t: " (rtos lg_clo 2 3) "\n Rayon du cercle \t: " (rtos dxf_r 2 3) "\n Centre du cercle \t: X= " (rtos (car dxf_m) 2 3) " Y= " (rtos (cadr dxf_m) 2 3) "\nFin le la clothoïde \t: X=" (rtos (car (matrix (list (car lst_r) (cadr lst_r) 0.0))) 2 3) " Y= " (rtos (cadr (matrix (list (car lst_r) (cadr lst_r) 0.0))) 2 3) "\n______________________________" ) ) ) (T (prompt "\nLongueur de clothoïde trop importante pour être résolue") (command "_.undo" "_end") (command "_.u") ) ) ) (T (prompt "\nLa droite coupe le cercle ou ripage trop important; pas de solution .") ) ) ) (T (prompt "\nEntité sélectionnée n'est ni un cercle, ni un arc, ou n'est pas parallèle au SGC!") (command "_.undo" "_end") (command "_.u") ) ) ) (T (prompt "\nEntité sélectionnée n'est pas une ligne, ou n'est pas parallèle au SGC!") (command "_.undo" "_end") (command "_.u") ) ) ) (prompt "\nVous n'êtes pas dans le systeme de coordonnées général ! RECTIFIEZ S.V.P") ) (setvar "cmdecho" 1) (prin1) ) La routine d'info pour utiliser après coup (defun c:idclo ( / esel ename elist xd_list cnt10 cnt40 app_list app_sub_list xd_code xd_data ) (while (not (setq esel (entsel))) ) (setq ename (car esel)) (redraw ename 3) (setq elist (entget ename (list "ID_CLOTHOIDE-BONUSCAD$2002"))) (if (not (setq xd_list (assoc -3 elist))) (princ "\nAucune donnée d'objet étendue n'est associée a une clothoïde.") (setq xd_list (cdr xd_list) cnt10 0 cnt40 0) ) (while xd_list (setq app_list (car xd_list)) (textscr) (princ "\nApplication enregistrée : \t") (princ (car app_list)) (princ "\n\t\tATTENTION *** ATTENTION") (princ "\nToutes modifications de cette polyligne optimisée") (princ "\ninvalident une partie ou toutes ces informations.") (princ "\nIndices de construction d'ORIGINE de cette clothoïde.\n") (setq app_list (cdr app_list)) (while app_list (setq app_sub_list (car app_list)) (setq xd_code (car app_sub_list)) (setq xd_data (cdr app_sub_list)) (cond ((= 1010 xd_code) (cond ((= cnt10 2) (setq cnt10 (1+ cnt10)) (princ "\nFin de la clothoïde : \t") ) ((= cnt10 1) (setq cnt10 (1+ cnt10)) (princ "\nCentre du cercle : \t") ) ((= cnt10 0) (setq cnt10 (1+ cnt10)) (princ "\nOrigine clothoïde : \t") ) ) (princ (strcat (rtos (car xd_data) 2 3) " , " (rtos (cadr xd_data) 2 3) " , " (rtos (caddr xd_data) 2 3) ) ) ) ((= 1040 xd_code) (cond ((= cnt40 5) (setq cnt40 (1+ cnt40)) (princ "\nRayon du cercle : \t") (princ (rtos xd_data 2 3)) ) ((= cnt40 4) (setq cnt40 (1+ cnt40)) (princ "\nLongueur de la clothoïde : \t") (princ (rtos xd_data 2 3)) ) ((= cnt40 3) (setq cnt40 (1+ cnt40)) (princ "\nAngle Tau : \t") (princ (angtos xd_data (getvar "unitmode") 5)) ) ((= cnt40 2) (setq cnt40 (1+ cnt40)) (princ "\nDelta R : \t") (princ (rtos xd_data 2 3)) ) ((= cnt40 1) (setq cnt40 (1+ cnt40)) (princ "\nParamètre de la clothoïde : \t") (princ (rtos xd_data 2 3)) ) ((= cnt40 0) (setq cnt40 (1+ cnt40)) (princ "\nOrientation de l'infini : \t") (princ (angtos xd_data (getvar "unitmode") 5)) ) ) ) (T) ) (setq app_list (cdr app_list)) ) (setq xd_list (cdr xd_list)) ) (redraw ename 4) (prin1) )
  20. Covadis a surement de telles fonctions. Sans ce progiciel, autocad n'a pas de fonctions standards pour réaliser ceci. Cependant pour un besoin ponctuel sans devoir acquérir des applications spécifiques, on peut utiliser des routines en lisp pour executer de telle courbes. Pour les paraboles tu peux regarder ce SUJET . Dans le même ordre, je dispose d'une routine pour créer un raccordement progressif (clothoide) entre une droite et un cercle (avec un deltaR raisonnable) Si tu en as besoin fais le savoir.
  21. Oui et Non! Après tout le language lisp et un peu comme le language des sourds, il est universel. Il m'arrive d'explorer des forums étrangers sur le lisp, et si je ne comprends pas la langue, il m'arrive de comprendre ce que doit faire la routine par une lecture sommaire du code. Il est donc normal que d'autres aient la même démarche.... J'ai justement dans mon freezer une bonne "Zubrowska", j'adore la boire nature bien glacée. (avec modération, c'est pour ça qu'elle est encore dans mon freezer ;) ) Conclusion, ce sera bien volontier que j'offrirais un coup à Evgeniy. Aujourd'hui il est sur le forum, demain il est chez moi à boire un verre :cool:
  22. Si les nombres sont une chaine de caractères, il vaut mieux faire ceci: (type (read "az")) --> SYM (type (read "1")) --> INT (type (read "1.5")) --> REAL donc (cond ((or (eq (type (read NumPlan)) 'INT) (eq (type (read NumPlan)) 'REAL)) (princ "\n...Ok c'est un chiffre") ) (T (princ "\n...Ce n'est pas un chiffre") ) )
  23. J'ai essayer avec le bloc-note, pas de problème. Passe d'abords par lui, quitte à le réouvrir avec l'éditeur Vlisp par la suite.... pour l'indenter. C'est peut une histoire de formatage de texte qui pose ce problème dans ce dernier?! PS: Pour talus, j'ai l'intention de le réecrire en vlax quand j'aurais du temps, en ce moment je suis trop occupé. Merci du retour en tout cas. [Edité le 24/10/2006 par bonuscad]
  24. Denis, Un exemple (un peu ancien, simple lisp) que j'utilise encore pour faire les peintures au sol lors d'aménagement routier. Ce lisp permet de tracer à la bonne échelle pour l' "echeltp" en cours (donc un appliquant les normes: nationale, départementale). Dans le lisp le fichiers lin est contruit en conséquence de l'échelle. Voilà, si ça peut te donner des idées.... (defun sgnerr (ch / ) (cond ((eq ch "Function cancelled") nil) ((eq ch "quit / exit abort") nil) ((eq ch "console break") nil) (T (princ ch)) ) (setq *error* olderr) (setvar "cmdecho" oldcmd) (princ) ) (defun c:hzoff ( / oldcmd) (setq oldcmd (getvar "cmdecho")) (setvar "cmdecho" 0) (setvar "plinewid" 0.0) (setvar "celtype" "BYLAYER") (command "_.redefine" "polylign") (command "_.redefine" "_pline") (prompt "\nCommande POLYLIGN redéfinie en standard") (setvar "cmdecho" oldcmd) (prin1) ) (defun c:hzon ( / oldcmd) (setq oldcmd (getvar "cmdecho")) (setvar "cmdecho" 0) (command "_.undefine" "polylign") (command "_.undefine" "_pline") (prompt "\nCommande POLYLIGN redéfinie en mode signalisation horizontale") (setvar "cmdecho" oldcmd) (prin1) ) (defun c:polylign () (c:_pline) ) (defun c:_pline ( / oldcmd entry wid_pl mod_tl) (setq oldcmd (getvar "cmdecho")) (setq olderr *error* *error* sgnerr) (setvar "cmdecho" 0) (while (not wid_pl) (setq entry (getstring (strcat "\nDonner le type de U à tracer ou largeur de en cm [2U/3U/5U/50/25/15/10] <" (getvar "users1") "> : " ) ) ) (if (= entry "") (setq entry (getvar "users1")) ) (cond ((or (= entry "2U")(= entry "2u")) (setq wid_pl (* 2.0 (getvar "userr1"))) (setvar "users1" "2U") ) ((or (= entry "3U")(= entry "3u")) (setq wid_pl (* 3.0 (getvar "userr1"))) (setvar "users1" "3U") ) ((or (= entry "5U")(= entry "5u")) (setq wid_pl (* 5.0 (getvar "userr1"))) (setvar "users1" "5U") ) ((or (eq (atof entry) 50) (eq (atof entry) 25) (eq (atof entry) 15) (eq (atof entry) 10) ) (setq wid_pl (* 0.01 (atof entry))) (setvar "users1" (rtos (atof entry) 2 0)) ) (T (prompt "\nLa valeur doit être 2U, 3U, 5U, 50cm, 25cm, 15cm ou 10cm") (setq wid_pl nil) ) ) ) (setvar "plinewid" wid_pl) (if (= (getvar "users2") "") (setvar "users2" "CONTINU")) (initget "T1 TP1 T2 TP2 T3 TP3 Continu") (setq mod_tl (getkword (strcat "\nType de modulation [T1/TP1/T2/TP2/T3/TP3/Continu] <" (getvar "users2") ">: " ) ) ) (if (not mod_tl) (setq mod_tl (getvar "users2")) ) (cond ((eq mod_tl "T1") (setvar "celtype" "T1") ) ((eq mod_tl "TP1") (setvar "celtype" "T-PRIM1") ) ((eq mod_tl "T2") (setvar "celtype" "T2") ) ((eq mod_tl "TP2") (setvar "celtype" "T-PRIM2") ) ((eq mod_tl "T3") (setvar "celtype" "T3") ) ((eq mod_tl "TP3") (setvar "celtype" "T-PRIM3") ) ((eq mod_tl "Continu") (setvar "celtype" "CONTINUOUS") ) ) (setvar "users2" mod_tl) (alert (strcat "\n - Utilisez la commande HZOFF" "\npour activer la commande POLYLIGN standard." "\n - Utilisez la commande HZON" "\npour activer la commande POLYLIGN modifiée." ) ) (setq *error* olderr) (setvar "cmdecho" 1) (command "_.PLINE") (prin1) ) (defun c:signhz ( / oldcmd oldexp maj fac_tl val_tl nam_tl nam_fic fil_out val_u entry) (setq val_u nil) (setq oldcmd (getvar "cmdecho") oldexp (getvar "expert")) (setq olderr *error* *error* sgnerr) (setvar "cmdecho" 0) (setvar "expert" 3) (if (tblsearch "LTYPE" "T1") (setq maj T) (setq maj nil)) (setq fac_tl (getvar "ltscale")) (setq val_tl '( (3.0 -10.0) (1.5 -5.0) (3.0 -3.5) (0.5 -0.5) (3.0 -1.33) (20.0 -6.0) ) ) (setq nam_tl '( "*T1,longitudinale axial" "*T-PRIM1,longitudinale axial" "*T2,longitudinale de rive" "*T-PRIM2,transversale" "*T3,longitudinale axial" "*T-PRIM3,longitudinale de rive" ) ) (if (zerop (getvar "dwgtitled")) (setq nam_fic (strcat (getvar "dwgprefix") (getvar "dwgname") ".LIN")) (setq nam_fic (strcat (getvar "dwgname") ".LIN")) ) (setq fil_out (open nam_fic "w")) (while val_tl (write-line (car nam_tl) fil_out) (write-line (strcat "A," (rtos (/ (caar val_tl) fac_tl) 2 4) "," (rtos (/ (cadar val_tl) fac_tl) 2 4) ) fil_out ) (setq nam_tl (cdr nam_tl) val_tl (cdr val_tl)) ) (close fil_out) (command "'_.LINETYPE" "_LOAD" "*" nam_fic "") (prompt (strcat "\nLes types de lignes T1 T'1 T2 T'2 T3 et T'3 sont définies et chargées" "\npour un facteur d'échelle de : " (rtos fac_tl 2 2) ) ) (while (not val_u) (initget 6) (setq entry (getreal "\nDonner la valeur de U en centimètres [7.5/6/5/3] <6>: ")) (cond ((or (eq entry 7.5) (eq entry 6) (eq entry 5) (eq entry 3) ) (setq val_u entry) ) ((not entry) (setq val_u 6.0) ) (T (prompt "\nLa valeur de U doit être de 7.5cm, 6cm, 5cm ou 3cm") (setq val_u nil) ) ) ) (setq val_u (* 0.01 val_u)) (setvar "userr1" val_u) (setvar "fillmode" 1) (setvar "plinegen" 1) (command "_.undefine" "polylign") (command "_.undefine" "_pline") (if maj (progn (prompt "\nMise à jour des entitées avec la nouvelle définition par un REGEN") (command "_.regenall") ) (prompt (strcat "\nSi vous voulez changez l'échelle du type de ligne, ou la valeur de U" "\nrelancez la commande SIGNHZ" "\nNB: Les polylignes tracées auparavant garderont l'ancienne valeur de U." ) ) ) (setvar "expert" oldexp) (setvar "cmdecho" oldcmd) (setq *error* olderr) (prin1) )
  25. Au début, j'ai essayé d'imposé le format Whip. Puis Autodesk a bifurqué sur VoloView et puis un Viewver présenté sous différentes sortes. Résultat, des galères des clients pour arriver à lire un fichier, compatibilité du viewer avec le fichier fourni. Le PDF arrive la plupart du temps à se lire, quelque soit la version utilisé du reader. Trop de cafoulliage au début de la part d'Autodesk, qui m'a découragé pour l'instant d'utiliser un tel produit. En plus la dématérialisation de dossier de consultation a renforcé ce choix fait sur le PDF. La secraitaire qui téléchargera le dossier pourra voir les pieces sans se poser de question :P Même si c'est une blonde Je vais me faire incendier par la gente féminine :(
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité