Lisps de gile

[lolobala]

Bonjour à tous, et merci à gile et patrick 35 pour tout ces lisps très intéressant. J'en utilise une bonne partie et ils me sont très utile.

Néanmoins j'ai une petite demande d'amélioration sur MES3D.

 

Dans mon exemple la longueur du segment est de 500 :

 

Sur ma courbe, j'aimerai que 500 mm soit la cote de la corde et pas celle de l'arc.

 

Je n'ai aucune connaissance en lisp et à vrai dire je n'y comprend rien.

 

Merci d'avance pour votre aide.

 

A bientôt

 

 

[(gile)]

Salut,

 

Il ne s'agirait pas d'une "amélioration" mais d'une toute autre routine le principe étant fondamentalement différent.

 

Regarde le LISP chariot qui devrait faire ce que tu demandes.

[lolobala]

Merci gile pour ta réponse très rapide, malheureusement le lisp chariot ne me convient pas.

 

Je dois insérer un bloc suivant une polyligne (droite+courbe) à égal distance (exemple 500), le bloc restant à la perpendiculaire de la trajectoire. Sur une droite MES3D marche bien mais dès que je suis sur une courbe, je souhaite prendre le chemin le plus court sans passer par l'arc.

 

Peut-être devrais-je raisonner autrement, en traçant une ligne brisé de segments égaux passant par la polyligne. Ensuite à chaques intersections insérer mon bloc qui sera perpendiculaire à la trajectoire.

 

C'est assez complexe comme demande, mais ça me ferait gagner un temps fou, c'est une étape que je répète plusieurs fois par jour.

 

Merci

[(gile)]

Essaye celui-ci.

 

Tu insères le bloc, tu l'orientes par rapport à l'axe X du SCG comme tu veux qu'il soit orienté sur la courbe.

Tu lances TOTO tu sélectionnes la courbe puis le bloc et tu spécifies un premier point qui correspondra à l'insertion du bloc sur la courbe puis un deuxième à la distance requise parallèlement à l'axe X du SCG.

 

(defun c:toto (/	  *error* curve	  endParam	  bloc
	  pt1	  pt2	  seg	  len	  angBase dist
	  space	  cen	  circ	  lst	  ext	  copy
	 )
 (vl-load-com)
 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "Erreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (if
   (and
     (setq curve (car (entsel "\nSélectionnez la courbe: ")))
     (setq endParam (vlax-curve-getEndParam curve))
     (setq bloc (car (entsel "\nSélectionnez l'objet: ")))
     (setq pt1 (getpoint "\nSpécifiez le premier point sur le bloc: "))
     (setq
pt2 (getpoint pt1 "\nSpécifiez le second point sur le bloc: ")
     )
     (setq curve   (vlax-ename->vla-object curve)
    bloc    (vlax-ename->vla-object bloc)
    len	    (vlax-curve-getDistAtParam curve endParam)
    pt1	    (trans pt1 1 0)
    pt2	    (trans pt2 1 0)
    angBase (angle pt1 pt2)
    rad	    (distance pt1 pt2)
    dist    0.0
    space   (vla-get-ModelSpace *acdoc*)
    cen	    (vlax-curve-getStartPoint curve)
     )
   )
    (progn
      (vla-StartUndoMark *acdoc*)
      (while cen
 (setq param (vlax-curve-getParamAtPoint curve cen)
       circ  (vla-AddCircle space (vlax-3d-Point cen) rad)
       lst   (3d-coord->pt-lst
	       (vlax-invoke circ 'IntersectWith curve acExtendNone)
	     )
       ext   (car
	       (vl-remove-if
		 '(lambda (x)
		    (			  )
		 (vl-sort lst
			  '(lambda (x1 x2)
			     (					(vlax-curve-getparamAtPoint curve x2)
			     )
			   )
		 )
	       )
	     )
 )
 (vla-Delete circ)
 (setq copy (vla-copy bloc))
 (vla-Move copy (vlax-3d-point pt1) (vlax-3d-point cen))
 (vla-Rotate
   copy
   (vlax-3d-point cen)
   (+ angBase (angle '(0 0 0) (vlax-curve-getFirstDeriv curve param)))
 )
 (setq cen ext)
      )
      (vla-EndUndoMark *acdoc*)
    )
 )
 (princ)
)

;;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points
;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))



(defun 3d-coord->pt-lst	(lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
  (3d-coord->pt-lst (cdddr lst))
   )
 )
)

[lolobala]

Je viens de tester ce dernier,

La distance marche bien, mais il y a un problème avec l'orientation, mon bloc n'est pas perpendiculaire à la trajectoire.

[lolobala]

En fait non, j'avais mal compris, milles excuses le dernier lisp marche très bien.

Il marche même nickel. Je te remercie.

 

Je vais être chiant, mais à ton avis, le lisp chariot peut-il avoir ce même principe de passer par la corde et non la longueur d'arc ? Je pense que oui, car tu est capable de tout.

 

Je serai comblé si tu y parvenais. J'ai beau regarder ce code dans tout les sens, je ne comprend rien.

 

 

[(gile)]

Je ne comprends pas bien la demande, le LISP ci-dessus est une adaptation de chariot pour considérer les longueurs rectilignes plutôt que les longueurs sur la courbe.

[lolobala]

Effectivement j'ai vu que les 2 lisp était très proche l'un de l'autre. J'ai regardé les différences pour comprendre ce qui avait été modifié pour que ça change fondamentalement les choses.

Voilà ce que j'ai constaté en testant chariot et toto.

Toto ne conserve pas la perpendiculaire à la trajectoire, dans mon test j'ai fait 3 arcs de cercle d'affilé,

les blocs sont bien placé dans les 2 premiers arc mais mal orienté dans le troisième.

Chariot conserve bien la trajectoire sur les 3 arcs. Mais prend en compte la longueur de courbe (normal).

C'est pour ça que je regarde ce qu'il y a en plus ou en moins, mais j'y comprend vraiment pas grand chose.

Il n'y aurait-il pas une histoire de sens dans le tracer de la polyligne, trigonométrique ou anti-trigo ?

 

[(gile)]

les blocs sont bien placé dans les 2 premiers arc mais mal orienté dans le troisième.

 

Je ne comprends pas ce que tu veux dire par là. L'orientation de l'objet copié est toujours calculé de façon à aligner l'angle de base (angle entre le premier et le second point spécifié) et la tangente à la courbe.

[lolobala]

Alors je dois mal m'y prendre.

Je ne suis pas sûr d'avoir bien compris la première étape.

 

Tu insères le bloc, tu l'orientes par rapport à l'axe X du SCG comme tu veux qu'il soit orienté sur la courbe.

Tu lances TOTO tu sélectionnes la courbe puis le bloc et tu spécifies un premier point qui correspondra à l'insertion du bloc sur la courbe puis un deuxième à la distance requise parallèlement à l'axe X du SCG.

 

 

D'ailleurs c'est quoi le SCG ? C'est le SCUD ?

 

[(gile)]

Le SCG c'est le Système de Coordonnées Général.

Le plus simple est de te mettre dans ce système avant de lancer la commande (commande SCU option Général ou _World ou Entrée)

 

En spécifiant les deux points, on spécifie :

- avec le premier point, le point de base qui servira à l'insertion de l'objet (qui peut être un bloc ou non)

- avec second, la distance et l'angle de base (par rapport au premier point).

 

Pour visualiser plus facilement l'orientation de l'objet par rapport à la courbe, je proposais d'orienter d'abord l'objet par rapport à l'axe X du SCG (dans ton cas insertion avec rotation de 90°) puis de spécifier les deux points parallèlement à l'axe X (angle de base = 0°).

 

Tu peux aussi bien insérer le bloc avec une rotation = 0° et spécifier le deuxième point à -90° du premier (parallèlement à l'axe Y dans les valeurs négatives).

[lolobala]

Bon bah en faite j'avais bien compris.

La routine toto marche bien avec mon premier bloc, mais pas avec le deuxième qui est grosso modo un simple trait.

Pour le deuxième bloc mon cas ressemble à chariot car les extrémités du trait doivent passer par la polyligne. Le problème est que chariot caclcul par rapport à la longueur d'arc. Toto ne prend pas en compte le deuxième point de ce trait.

Je crois que je me suis très mal expliqué depuis le début. Je suis vraiment désolé.

 

[lolobala]

J'ai essayé de faire un mélange des 2 lisps, mais ça marche pas.

En faite, dans toto j'ai introduit la ligne de chariot :

 (setq seg (getdist "\nSpécifiez la longueur du segment: "))

Je pense que c'est l'idée à adopter pour faire en sorte que le deuxième point de mon bloc soit sur la polyligne.

J'ai également insérer la ligne

dist  (+ dist seg)

Mais c'est comme si je n'avais rien fait.

 

En fait ce que je voudrais faire, c'est calculer à la manière de toto et positionner mon bloc correctement à la manière de chariot.

 

Dites-moi seulement si je suis sur la bonne voie, parce que là je vois pas....

 

Merci de m'aider

 

[Edité le 12/3/2010 par lolobala]

[lolobala]

Je sais que tout le monde est bien occupé.

Je sais aussi que je ne suis pas vraiment dans le bon forum.

Ce que je ne sais pas c'est comment résoudre mon problème.

Ce que je sais encore moins c'est parler ce langage qui parait malgré tout très intéressant.

Ce que je sais c'est que personne ne veut me répondre, ou alors personne ne sait comment faire.

Ou alors personne n'a compris ma demande.

Je crois que tant pis pour moi, à moins que quelqu'un me vienne en aide.

Je désepère, au bout du rouleau...

J'ai pris le temps de regarder les autres sujets...mais en vain....Je ne sais pas quoi faire

[(gile)]

Si j'ai bien compris la demande celui-ci y répondre (renomme le comme tu veux).

 

(defun c:chariot (/	  *error* curve	  endParam	  bloc
	  pt1	  pt2	  seg	  len	  angBase dist
	  space	  cen	  circ	  lst	  ext 	  copy
	 )
 (vl-load-com)
 (defun PointAfter (lst param)
   (car
     (vl-remove-if
'(lambda (x) (	(vl-sort lst
	 '(lambda (x1 x2)
	    (		       (vlax-curve-getparamAtPoint curve x2)
	    )
	  )
)
     )
   )
 )
 
 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "Erreur: " msg))
   )
   (vla-EndUndoMark *acdoc*)
   (princ)
 )
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (if
   (and
     (setq curve (car (entsel "\nSélectionnez la courbe: ")))
     (setq endParam (vlax-curve-getEndParam curve))
     (setq bloc (car (entsel "\nSélectionnez l'objet: ")))
     (setq pt1 (getpoint "\nSpécifiez le premier point sur le bloc: "))
     (setq
pt2 (getpoint pt1 "\nSpécifiez le second point sur le bloc: ")
     )
     (setq seg (getdist "\nSpécifiez la longueur du segment: "))
     (setq curve (vlax-ename->vla-object curve))
     (setq bloc (vlax-ename->vla-object bloc))
     (setq angBase (angle pt1 pt2))
     (setq rad (distance pt1 pt2))
     (setq dist 0.0)
     (setq param 0.0)
     (setq space (vla-get-ModelSpace *acdoc*))
     (setq cen (vlax-curve-getStartPoint curve))
     (setq circ (vla-AddCircle space (vlax-3d-Point cen) rad))
     (setq lst	(3d-coord->pt-lst
	  (vlax-invoke circ 'IntersectWith curve acExtendNone)
	)
     )
     (not (vla-delete circ))
     (setq ext (PointAfter lst param))
   )
    (progn
      (vla-StartUndoMark *acdoc*)
      (while ext
 (setq copy (vla-copy bloc))
 (vla-Move copy (vlax-3d-point pt1) (vlax-3d-point cen))
 (vla-Rotate
   copy
   (vlax-3d-point cen)
   (- (angle cen ext) angBase)
 )
 (setq circ (vla-AddCircle space (vlax-3d-Point cen) seg)
       lst  (3d-coord->pt-lst
	      (vlax-invoke circ 'IntersectWith curve acExtendNone)
	    )
       cen  (PointAfter lst param)
 )
 (vla-delete circ)
 (if cen
   (progn
     (setq param (vlax-curve-getParamAtPoint curve cen)
	   circ	 (vla-AddCircle space (vlax-3d-Point cen) rad)
	   lst	 (3d-coord->pt-lst
		   (vlax-invoke
		     circ
		     'IntersectWith
		     curve
		     acExtendNone
		   )
		 )
	   ext	 (PointAfter lst param)
     )
     (vla-Delete circ)
   )
   (setq ext nil)
 )
      )
      (vla-EndUndoMark *acdoc*)
    )
 )
 (princ)
)

;;; 3d-coord->pt-lst Convertit une liste de coordonnées 3D en liste de points
;;; (3d-coord->pt-lst '(1.0 2.0 3.0 4.0 5.0 6.0)) -> ((1.0 2.0 3.0) (4.0 5.0 6.0))

(defun 3d-coord->pt-lst	(lst)
 (if lst
   (cons (list (car lst) (cadr lst) (caddr lst))
  (3d-coord->pt-lst (cdddr lst))
   )
 )
)

[lolobala]

Merci Gile, de te pencher à nouveau sur mon problème

Je vais tester ça tout de suite.

 

[lolobala]

C''est nickel, c'est exactement ce que je voulais.

Mille fois merci. Tu viens de me faire gagner un temps précieux.

@+

[FRAXA]

Salut Gile!

 

J'ai un petit souci avec le lips Edit_bloc_rep, lorsque je le lance, j'ai le message d'erreur suivant: Erreur Automation Erreur de fichier.

 

Je suis sur Autocad 2010, le dessin est vide quand je lance le lips.

 

J'ai voulu recharger le lips et mon ordinateur indique que le fichier zip est corrompu !!

[PHILPHIL]

HELLO GILE

 

aurais tu changer de machine il n'y a pas longtemps ?

 

ou de programme de compression zip ?

 

les fichiers *.zip que tu as mis en ligne sont pour la plupart corrompus

 

ou alors ca vient de notre systeme qui est passé en 64BITS

 

totalarea.zip me fait la meme chose que m'avait fait le fichier ici

 

http://cadxp.cadmag.info/sujetXForum-27114.htm

 

a+

 

phil

[(gile)]

Salut,

 

J'ai effectivement changé de machine il y a peu mais je ne pense pas que le problème vienne de là, les fichiers sont sur le serveur d'orange depuis bien avant.

 

Au vu des réponses dans le sujet cité, je pencherais plutôt pour un problème entre les pages perso orange (le téléchargement semble fonctionner avec dl.free pour toi et lecrabe) et le poste depuis lequel est fait le téléchargement (le téléchargement depuis mes pages perso fonctionne sur mes postes et celui de lili2006).

[bonuscad]

Bonsoir,

 

totalarea.zip me fait la meme chose

 

Pour rassurer, je vient de télécharger et ouvrir avec 7-Zip , donc ...

 

Un problème de CRC sur ta machine ! (tu décompresse avec l'utilitaire intégré à l'explorateur ?), un Anti-Virus tatillon !

En tout cas le problème à l'air propre à ta machine.

[(gile)]

Merci, ça me rassure mais pas complètement.

Ce que je trouve curieux c'est que, dans le sujet cité, PHILPHIL et lecrabe obtiennent un fichier corrompu depuis mes pages mais un fichier correct quand ils utilisent le lien de lili2006 (dl.free)...

[bonuscad]

Merci, ça me rassure mais pas complètement.

 

Je te comprends :(

 

Il est vrai que les FAI se livrent à de drôles de manœuvres.

Pour mon cas personnel, depuis que le Neuf s'est fait bouffé par SFR et bien je n'arrive même plus a accéder à la page Ifrance pour consulter mon webmail gratuit, alors que du boulot (le FAI qui est Orange je crois !) tout passe très bien :mad:

 

Mon navigateur me dit que l'adresse est rediriger et que la demande ne pourra aboutir.?!?!

 

Je pense aussi qu'ils Blaklistent facilement d'autres fournisseurs en se réfugiant derrière le combat qu'ils mènent contre le Spam.

 

Nous les consommateurs ont est juste bon à payer l'abonnement.

 

En aparté ma page perso sera bientôt supprimé par SFR, ils ont quand même eu la délicatesse de m'avertir longtemps à l'avance pour que je procède au transfert à une autre adresse (je ne l'ai pas encore fait...)

[lili2006]

Bonjour à toutes et tous,

 

Téléchargé depuis le lycée, (donc sur un autre poste avec réseau interne sécurisé) et renvoyé depuis dl.free => FICHIER 46.3 Ko compressé,semble ne pas poser de problème non plus ici,...

[PHILPHIL]

hello tous

 

merci lilian

 

la j'arrive nickel a la télécharger

 

4 fichiers dedans

 

bonne journée

 

phil