dilack

Bonjour Le lisp se lance correctement mais au moment du choix de supprimer ou non l'objet source j'ai une erreur et le prog ne pas à son terme. "; erreur: ARXLOAD a échoué" J'ai bien les chemins de recherche de fichiers support configurés. Je pense que ça viens de ma version de map, car ce lisp fonctionnait parfaitement sur d'autre version de mémoire. Je suis sur MAP 3D 2016 ;;; OB2WO 10/03/07 ;;; Crée des "Wipeout" à partir des objets sélectionnés (cercle, ellipse, ou polyligne avec arcs) ;;; Fonctionne en 3D ;;; Modifié le 03/11/07 ;;; - plusieurs objets peuvent être sélectionnés ;;; - le wipeout est créé sur le calque de l'objet (defun c:ob2wo (/ ent lst nor lay) (vl-load-com) (setq acdoc (vla-get-ActiveDocument (vlax-get-acad-object))) (if (ssget '((0 . "CIRCLE,ELLIPSE,LWPOLYLINE"))) (progn (initget "Oui Non") (setq del (getkword "\nEffacer les objets source ? [Oui/Non] <Non>: ")) (vla-StartundoMark acdoc) (vlax-for obj (vla-get-activeSelectionSet acdoc) (setq lst (ent2ptlst obj) nor (vlax-get obj 'Normal) lay (vla-get-Layer obj) ) (makeWipeout lst nor lay) (and (= del "Oui") (vla-delete obj)) ) (vla-EndundoMark acdoc) ) ) ) ;;; ENT2PTLST ;;; Retourne la liste des sommets successifs du polygone approchant un objet courbe ;;; Coordonnées exprimées dans le SCO (defun ent2ptlst (ent / obj dist n lst p_lst prec) (vl-load-com) (if (= (type ent) 'ENAME) (setq obj (vlax-ename->vla-object ent)) (setq obj ent ent (vlax-vla-object->ename ent) ) ) (cond ((member (cdr (assoc 0 (entget ent))) '("CIRCLE" "ELLIPSE")) (setq dist (/ (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) 50 ) n 0 ) (repeat 50 (setq lst (cons (trans (vlax-curve-getPointAtDist obj (* dist (setq n (1+ n)))) 0 (vlax-get obj 'Normal) ) lst ) ) ) ) (T (setq p_lst (vl-remove-if-not '(lambda (x) (or (= (car x) 10) (= (car x) 42) ) ) (entget ent) ) ) (while p_lst (setq lst (cons (append (cdr (assoc 10 p_lst)) (list (cdr (assoc 38 (entget ent)))) ) lst ) ) (if (/= 0 (cdadr p_lst)) (progn (setq prec (1+ (fix (* 25 (sqrt (abs (cdadr p_lst)))))) dist (/ (- (if (cdaddr p_lst) (vlax-curve-getDistAtPoint obj (trans (cdaddr p_lst) ent 0) ) (vlax-curve-getDistAtParam obj (vlax-curve-getEndParam obj) ) ) (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) ) prec ) n 0 ) (repeat (1- prec) (setq lst (cons (trans (vlax-curve-getPointAtDist obj (+ (vlax-curve-getDistAtPoint obj (trans (cdar p_lst) ent 0) ) (* dist (setq n (1+ n))) ) ) 0 ent ) lst ) ) ) ) ) (setq p_lst (cddr p_lst)) ) ) ) lst ) ;;; ;;; ;;; MakeWipeout ;;; Crée un objet "wipeout" à partir d'une liste de points et du vecteur normal de l'objet (defun MakeWipeout (pt_lst nor lay / dxf10 max_dist cen dxf_14) (or (member "acwipeout.arx" (arx)) (arxload "acwipeout.arx")) (setq dxf10 (list (apply 'min (mapcar 'car pt_lst)) (apply 'min (mapcar 'cadr pt_lst)) (caddar pt_lst) ) ) (setq max_dist (float (apply 'max (mapcar '- (apply 'mapcar (cons 'max pt_lst)) dxf10) ) ) ) (setq cen (mapcar '+ dxf10 (list (/ max_dist 2) (/ max_dist 2) 0.0))) (setq dxf14 (mapcar '(lambda (p) (mapcar '/ (mapcar '- p cen) (list max_dist (- max_dist) 1.0) ) ) pt_lst ) ) (setq dxf14 (reverse (cons (car dxf14) (reverse dxf14)))) (entmake (append (list '(0 . "WIPEOUT") '(100 . "AcDbEntity") (cons 8 lay) '(100 . "AcDbWipeout") '(90 . 0) (cons 10 (trans dxf10 nor 0)) (cons 11 (trans (list max_dist 0.0 0.0) nor 0)) (cons 12 (trans (list 0.0 max_dist 0.0) nor 0)) '(13 1.0 1.0 0.0) '(70 . 7) '(280 . 1) '(71 . 2) (cons 91 (length dxf14)) ) (mapcar '(lambda (p) (cons 14 p)) dxf14) ) ) ) ;;; ;;; ;;; (defun errlsp (ch) (cond ((eq ch "Function cancelled") nil) ((eq ch "quit / exit abort") nil) ((eq ch "console break") nil) (T (princ ch)) ) (setvar "cmdecho" v1) (setvar "orthomode" v2) (setvar "osmode" v3) (setvar "blipmode" v4) (setvar "snapang" v5) (setq *error* olderr) (princ) ) (defun C:pte ( / v1 v2 v3 v4 v5 d_pc flag p_o p_f dlt_x d olderr) (setq v1 (getvar "cmdecho") v2 (getvar "orthomode") v3 (getvar "osmode") v4 (getvar "blipmode") v5 (getvar "snapang") ) (setvar "cmdecho" 0) (setvar "orthomode" 0) (setvar "blipmode" 0) (setq olderr *error* *error* errlsp) (initget 1) (setq d_pc (getreal "\nEntrer la valeur de la pente (rampe) en % ?: ")) (initget 8) (setq echll (getpoint "\nEchelle du profil en long X,Y <1000,100>: ")) (if (eq echll ()) (setq echll '(1000 100))) (setq d_pc (* d_pc (/ (car echll) (cadr echll)))) (setq p_o (getpoint "\nPoint de départ : ")) (if (eq p_o ()) (setq p_o (getvar "lastpoint"))) (initget "Dans Avec _In With") (if (eq (getkword "\nPente [Dans/Avec] le plan XY : ") "With") (setq flag T) (progn (setvar "snapang" (atan (/ d_pc 100.0))) (setvar "orthomode" 1) (setq flag nil) ) ) (initget 41) (setq p_f (getpoint p_o "\nPoint final : ")) (setvar "osmode" (+ 16384 (rem (getvar "osmode") 16384))) (if flag (progn (setq dlt_x (sqrt (+ (* (- (car p_o) (car p_f)) (- (car p_o) (car p_f))) (* (- (cadr p_o) (cadr p_f)) (- (cadr p_o) (cadr p_f)))))) (setq d (* dlt_x (/ (sin (atan (/ d_pc 100.0))) (cos (atan (/ d_pc 100.0)))))) (setq p_f (list (car p_f) (cadr p_f) (+ (caddr p_o) d))) (command "_.line" p_o p_f "") ) (progn (setq dlt_x (- (car p_f) (car p_o))) (setq d (/ dlt_x (cos (atan (/ d_pc 100.0))))) (command "_.line" p_o (polar p_o (atan (/ d_pc 100.0)) d) "") ) ) (setvar "cmdecho" v1) (setvar "orthomode" v2) (setvar "osmode" v3) (setvar "blipmode" v4) (setvar "snapang" v5) (setq *error* olderr) (prin1) ) ;;; ;;; ;;; ;;; FUSION - 01/01/06 ;;; Crée une polyligne sur le contour de chaque gorupe de polylignes fermées et contiguës sélectionnées. (defun c:fus (/ gile_vl_err join-pline arcbulge AcDoc Space ss lst reg Norm expl objs regs olst blst plst dlst tlst blg pline ) (vl-load-com) ;;;***************************************************************;;; (defun gile_vl_err (msg) (if (or (= msg "Fonction annulée") (= msg "quitter / sortir abandon") ) (princ) (princ (strcat "\nErreur: " msg)) ) (vla-endundomark (vla-get-activedocument (vlax-get-acad-object)) ) (setq *error* m:err m:err nil ) (princ) ) ;;;***************************************************************;;; (defun arcbulge (arc) (/ (sin (/ (vla-get-TotalAngle arc) 4)) (cos (/ (vla-get-TotalAngle arc) 4)) ) ) ;;;***************************************************************;;; (setq AcDoc (vla-get-activeDocument (vlax-get-acad-object)) Space (if (= 1 (getvar "CVPORT")) (vla-get-PaperSpace AcDoc) (vla-get-Modelspace AcDoc) ) m:err *error* *error* gile_vl_err ) (prompt "\nSélectionnez les polylignes à fusionner: ") (if (setq ss (ssget '((0 . "LWPOLYLINE")))) (progn (vla-StartUndoMark AcDoc) (if (setq reg (vlax-invoke Space 'addRegion (mapcar 'vlax-ename->vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))) ) ) ) (progn (while (cadr reg) (vla-boolean (car reg) acUnion (cadr reg) ) (setq reg (cons (car reg) (cddr reg))) ) (setq reg (car reg) Norm (vlax-get reg 'Normal) expl (vlax-invoke reg 'Explode) ) (vla-delete reg) (while expl (setq objs (vl-remove-if-not '(lambda (x) (or (= (vla-get-ObjectName x) "AcDbLine") (= (vla-get-ObjectName x) "AcDbArc") ) ) expl ) regs (vl-remove-if-not '(lambda (x) (= (vla-get-ObjectName x) "AcDbRegion")) expl ) ) (if objs (progn (setq olst (mapcar '(lambda (x) (list x (vlax-get x 'StartPoint) (vlax-get x 'EndPoint) ) ) objs ) ) (while olst (setq blst nil) (if (= (vla-get-ObjectName (caar olst)) "AcDbArc") (setq blst (list (cons 0 (arcbulge (caar olst))))) ) (setq plst (cdar olst) dlst (list (caar olst)) olst (cdr olst) ) (while (setq tlst (vl-member-if '(lambda (x) (or (equal (last plst) (cadr x) 1e-9) (equal (last plst) (caddr x) 1e-9) ) ) olst ) ) (if (equal (last plst) (caddar tlst) 1e-9) (setq blg -1) (setq blg 1) ) (if (= (vla-get-ObjectName (caar tlst)) "AcDbArc") (setq blst (cons (cons (1- (length plst)) (* blg (arcbulge (caar tlst))) ) blst ) ) ) (setq plst (append plst (if (minusp blg) (list (cadar tlst)) (list (caddar tlst)) ) ) dlst (cons (caar tlst) dlst) olst (vl-remove (car tlst) olst) ) ) (setq pline (vlax-invoke Space 'addLightWeightPolyline (apply 'append (mapcar '(lambda (x) (setq x (trans x 0 Norm)) (list (car x) (cadr x)) ) (reverse (cdr (reverse plst))) ) ) ) ) (vla-put-Closed pline :vlax-true) (mapcar '(lambda (x) (vla-setBulge pline (car x) (cdr x))) blst ) (vla-put-Elevation pline (caddr (trans (car plst) 0 Norm)) ) (vla-put-Normal pline (vlax-3d-point Norm)) (vla-Highlight pline :vlax-true) (mapcar 'vla-delete dlst) ) ) ) (if regs (progn (setq expl (append (vlax-invoke (car regs) 'Explode) (cdr regs) ) ) (vla-delete (car regs)) ) (setq expl nil) ) ) ) ) (vla-EndUndoMark AcDoc) ) ) (setq *error* m:err m:err nil ) (princ) ) Merci d'avance pour votre retour!

Salut Thierry, le problème c'est que je ne maîtrise pas totalement les subtilités d'autopiste pour passer Multi axes

Salut Didier, Une rotation progressive des profils??? Je sais jouer sur l'orientation des profils, mais là c'est un peu trop exigu pour avoir une tripoté de profils intermédiaires Je pense pas qu'on puisse représenter les structures des plateformes sur des profils en travers. Après je te dirais que le contrôleur il a un peu rouler sa bosse, et qu'on peu difficilement le mener en bateau! :D En passant... tu me sort de la misère avec ton site perso! Enfin un site en français.... @+

Bonjour tout le monde, J'aimerais avoir des conseils pour effectué ce raccordement de voirie projet sur une voirie existante. Je vois pas trop comment m'y prendre... hormis en plusieurs étapes avec une section et une patte d'oie pour pour la partie circulaire. Merci d'avance pour vos réponses

Bonjour, personnellement j'ai tendance à accrocher mes projets aux "MNT Projet" N-1 pour éviter tous problèmes. Ensuite pour être certain de mes raccordements je fait mes "atterrissages" sur les polylignes 3D issues de mon MNT Projet précedent. D'ailleur géomédia préconise cette solution Encore faut-il avoir restituer le MNT en le cochant dans la boite de dialogue les bonnes options Cordialement

Bonjour didier, merci, je me suis aux contraintes et j'ai encore un peu de mal! je crois que vais avoir encore des soucis sur ce bloc! :D Cdt

Bonjour à tous, Je m’arrache les cheveux sur un petit soucis de dynamisme sur un bloc. Suivant l’image ci-après quand je bouge mon grip n°1 le grip n°2 n’est plus consécutif aux éléments dessinés. J’ai essayé plus possibilités que je connaissais et là je tourne en rond, en carré etc …. Je vous laisse le fichier dwg en pièces jointe https://we.tl/UxJ0Lu6bJ8 Merci d’avance pour vos lumières.

Bonjour, je travail en bureau étendu! le problème est résolu, il fallait simplement insérer un bloc pour que la position de la boite de dialogue s'enregistre! Faut le savoir! Je connaissais pas les manips pour déplacer des fenêtres invisible. Merci à tout les deux de m'avoir dépanner.

merci Lilian, par contre la position ne reste pas en mémoire, il faut que je la ramène à chaque fois! Y at-il une variable pour enregistrer la position?

Re Didier :P effectivement c'est ça! Comment je peux "ré encrer" ma boite de dialogue correctement?

Bonjour à tous, J'ai un gros problème d'affichage des boites de dialogues. Sur les commandes bloc et insérer bloc, les boites de dialogue ne s'affichent pas! :blink: J'ai regardé du coté des variables fildia et cmddia, elles sont à 1 toutes les deux. A tout hasard j'ai redémarré autocad et le pc sans succès. Une idée? Merci d'avance pour vos réponse

Salut, regarde tes mail wanadoo Lilian. j'ai d'autre document sur les terrassement si tu en as envie @+

oups ....... j'ai les yeux collés .... désolé c'est ma nuit blanche qui me pèse! :o

Bonjour, Je souhaite insérer un block dans un profil type dty... Si quelqu'un à la manip je suis preneur. Merci d'avance de vos réponses

Salut Didier, Effectivement avec un intervalle à 2 à ça va un peu mieux! Merci

SSalut Effectivement certaines tabulation n'étaient pas assez grandes!!! Oui c'est les même PTT

Une petite question... non deux !!! désolé Autopiste ne calcul pas des profils fictifs comme covadis? Sur certains profil la courbe du décapage n’apparaît pas alors que je suis passer par le décapage général!?

Merci de la réponse... le soucis c'est quand je me balade en vue 3D cette partie est bien en remblai c'est le dessin du talus qui merdouille... Et oui je suis bien par profil type par point!

Bonsoir,http:// j'ai mes interfaces entre mes talus en déblai/remblai qui me perturbent. Ces interfaces se font bizarrement et je ne vois pas comment les affinées hormis de positionner une tabulation. Une autre idée serait la bien venue.

Je sais mais je subit un service informatique!!!!

merci pour tes réponses La Lozère, mais sous la version 21.0.1.172 j'ai pas ce genre de boite de dialogue avec la commande "PistToPreferences"... :( Edité: Oups .... j'ai des liste déroulantes à la place... Merci...

Bonjour, Je recherche à configurer les couleur des polylignes et des talus dessinés par le "calcul de l'axe" dans autopiste. J'ai essayé de regardé dans tous les sous menus sans trouver. Merci d'avance pour vos réponses. @+

Bonsoir, ça me fait penser à des contrôles de rails de ponts roulant, si c'est le cas je me servais d'un fichier excel et non d'autocad. Je sais je te donne pas de solution par contre si tu veux la feuille de calcul je dois encore l'avoir sur un disque. @ plus

Salut, de mon coté la fonction recherche ... fonctionne correctement .... mais sans le tri

Bonjour, je te propose un lisp qui permet de dessiner des segments droits consécutif de couleur noir et rouge. cdt (defun c:GBA(/ Cmd Co Coo Compt ep Lg os Pt1 Pt2 Pts Pas s) (defun *errmp* (msg) (if (/= msg "Function cancelled") (if (= msg "quit / exit abort") (princ) (princ (strcat "\nErreur : " msg)) ) (princ) ) (if os (setvar "osmode" os) ) (setvar "cecolor" coo) (command "_.undo" "_end") (setvar "cmdecho" Cmd) (setq *error* s) (princ) ) (defun cg_co() (setvar "cecolor" (itoa Co)) (if (= Co 1) (setq Co 7) (setq Co 1) ) ) (setq s *error*) (setq *error* *errmp*) (setq Cmd (getvar "cmdecho") Coo (getvar "cecolor")) (setvar "cmdecho" 0) (setq Ep (getstring (strcat "\nEpaisseur des polylignes <" (rtos (getvar "plinewid")) "> : "))) (if Ep (setvar "plinewid" (atof Ep)) ) (setq Pt1 (getpoint "\nPremier point : ") Pt2 '(0.0 0.0 0.0) Co 7 Compt 0) (if Pt1 (progn (setq Pts (list (cons 0 Pt1))) (while Pt2 (initget "Undo") (setq Pt2 (getpoint Pt1 "\nPoint suivant / Undo : ")) (if Pt2 (progn (if (= Pt2 "Undo") (progn (if (/= Compt 0) (progn (command "_.undo" "1") (setq Pts (vl-remove (assoc Compt Pts) Pts) Compt (1- Compt) Pt1 (cdr (assoc Compt Pts))) ) (princ "\nRien à annuler") ) ) (progn (command "_.undo" "_group") (setq os (getvar "osmode")) (setvar "osmode" 0) (setq Pas 0 Lg (* (getvar "ltscale") 2)) (while (< Pas (- (distance Pt1 Pt2) Lg)) (cg_co) (command "_.pline" (if (= Pas 0) Pt1 "@" ) (strcat "@" (rtos Lg) "<" (angtos (angle Pt1 Pt2) 0 16)) "") (setq Pas (+ Pas Lg)) ) (cg_co) (command "_.pline" "@" Pt2 "") (setvar "osmode" os) (setvar "cecolor" coo) (command "_.undo" "_end") (setq Pt1 Pt2 Compt (1+ Compt) Pts (append Pts (list (cons Compt Pt2)))) ) ) ) ) ) ) ) (setvar "cmdecho" Cmd) (setq *error* s) (princ) )