Aller au contenu

Lisp pour extraire les coordonnées de l'intersection des axes


Maxime85

Messages recommandés

Bonjour,

j ai un plan sous Autocad j aimerais avoir un lisp qui me permettra d' extraire les coordonnées des intersections des axes en un fichier .txt (réaliser avec la commande ligne) coordonnées x,y

Amicalement

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

Lien vers le commentaire
Partager sur d’autres sites

Coucou

 

pas de 3D dans tes lignes?

 

voila déjà pour avoir les coordonnées de l'intersection des lignes

(setq l1 (car (entsel "\nligne 1"))
     l2 (car (entsel "\nligne 2"))
     )
(setq intersection (inters
	       (list (car (cdr (assoc 10 (entget l1))))
		     (cadr(cdr (assoc 10 (entget l1))))
		     )
	       (list (car (cdr (assoc 11 (entget l1))))
		     (cadr (cdr (assoc 11 (entget l1))))
		     )
	       (list (car (cdr (assoc 10 (entget l2))))
		     (cadr(cdr (assoc 10 (entget l2))))
		     )
	       (list (car (cdr (assoc 11 (entget l2))))
		     (cadr (cdr (assoc 11 (entget l2))))
		     )
	       nil)
)

 

pour écrire dans un fichier tu as besoin de nous ?

 

amicalement

Modifié par didier
édité par didier pour correction du code
Lien vers le commentaire
Partager sur d’autres sites

Salut

 

Pour rebondir sur ce qu'a donné Didier, mais qui fonctionne aussi avec des arcs, splines, etc...

(vlax-invoke (vlax-ename->vla-object l1) 'IntersectWith (vlax-ename->vla-object l2) 0)

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

voici le bout de code (ok ce n'est pas parfait ....) mais il fonctionne. Et comme le code n'est pas parfait...ben je recherche juste à l'améliorer.

 

Ce que j'aimerais améliorer dans ce code , c'est d'avoir la possibilité de choisir moi-même le répertoire de destination ainsi que le nom de fichier.

 

Merci de votre aide.

 

(defun c:ptint ()

(vl-load-com)

(setq nomfic "C:/XYINT.txt")
(setq fic (open nomfic "w"))

(setq l1 (car (entsel "\nSélectionner la première ligne: "))
     l2 (car (entsel "\nSélectionner la seconde ligne: "))
     )
  
(setq valint (vlax-invoke (vlax-ename->vla-object l1) 'IntersectWith (vlax-ename->vla-object l2) 0))

(progn
			(setq xentit (car valint))
			(setq yentit (car (cdr valint)))
			
			(setq xyentit (strcat (rtos xentit 2 3) " " (rtos yentit 2 3)))
			
(write-line xyentit fic)

)
(close fic)

);fin de defun

 

Cordialement,

 

Laurent

Lien vers le commentaire
Partager sur d’autres sites

Salut

 

Ce que j'aimerais améliorer dans ce code , c'est d'avoir la possibilité de choisir moi-même le répertoire de destination ainsi que le nom de fichier.

Regarde la fonction lisp getfiled

 

ps : (car (cdr valint)) = (cadr valint)

pps : Pourquoi un progn dans le lisp ?

ppps : Dans la variable valint, tu peux avoir plusieurs coordonnées car deux polylignes peuvent se croiser plusieurs fois

 

@+

Les Lisps de Patrick

Le but n'est pas toujours placé pour être atteint, mais pour servir de point de mire.

Joseph Joubert, 1754-1824

Lien vers le commentaire
Partager sur d’autres sites

Bonjour,

 

Pour rebondir sur la remarque de Patrick_35

ppps : Dans la variable valint, tu peux avoir plusieurs coordonnées car deux polylignes peuvent se croiser plusieurs fois

 

Avec IntersectWith en plus de fonctionner avec les arcs splines etc.. Cela retourne également les intersections multiples, s’il y a lieu sous forme d’une liste de coordonnées.

 

 

A titre d'indication l’astuce que j’utilise avec IntersectWith c’est de travailler avec des listes de points, à cette fin j’utilise cette petite routine qui transforme les listes de coordonnées (x1 y1 z1 x2 y2 z2 ...) en liste de points ((x1 y1 z1) (x2 y2 z2) ...).

 

;; Transforme une liste de coordonnées en liste de point
;; Argument: Une liste du type (x1 y1 z1 x2 y2 z2 x3 y3 z3 ...)
;; Retourne: Une liste du type ((x1 y1 z1) (x2 y2 z2) (x3 y3 z3) ...)
;;                        soit (p1 p2 p3 ...)
;; Exemples :
;;   (bv:xyz->Pt '(x1 y1 z1 x2 y2 z2)) -> ((X1 Y1 Z1) (X2 Y2 Z2))
;;   (bv:xyz->Pt '(x1 y1 z1)) -> ((X1 Y1 Z1))

(defun bv:xyz->Pt (L)
 (if L
   (cons (list (car L) (cadr L) (caddr L))
  (bv:xyz->Pt (cdddr L))
   )
 )
)

 

Tu peux donc modifier ton programme comme ceci:

(setq valint (bv:xyz->Pt (vlax-invoke (vlax-ename->vla-object l1) 'IntersectWith (vlax-ename->vla-object l2) 0)))

 

Puis utilise une boucle au cas où tu aurais plusieurs coordonnées de points à écrire dans ton fichier. Mais attention pour la suite du traitement sur valint dans ton code, car les coordonnées (x y) sont à une profondeur supplémentaire.

 

Voilà comment je procède, il a certainement d’autres façon de faire..

A+ Bruno

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Bonjour ,

Merci pour vos interventions ,

mais la je ne m y retrouve pas quel lisp vais je choisir ?

j ai essayer un celui de VDH-Bruno et j obtient ceci

http://i42.servimg.com/u/f42/15/62/62/90/lm10.jpg

la cé bien mais cela est un peu touffu

serai pas possible qu'il extrait uniquement les coordonées des intersection

et le met sous cette forme

-0,0.0,0.0,0

-1,1.1,2.1,3

-2,1.2,2.2,3

- X . Y . Z .....

Amicalement

En devenant sincère, l'amour devient généreux.

 

Autocad Map 2015 Covadis V16  et Mensura V9

MacBook Pro 2019

Win10 64 bits

Lien vers le commentaire
Partager sur d’autres sites

Salut maxwell85

 

serai pas possible qu'il extrait uniquement les coordonées des intersection

C’est ce qu’il fait sauf qu’il te renvoie les coordonnés sous forme de liste...

 

 

mais la je ne m y retrouve pas quel lisp vais je choisir ?

Utilise le code fourni en lien réponse n°11 charge le dans Visual LISP, ainsi que les routines associées.

Une fois chargé tape (bv:ListInters (ssget)) dans la consol Visual LISP ou sur la ligne de commande pour tester.

 

En retour tu devrais avoir la liste des intersections des objets sélectionnés sous cette forme: ((X1 Y1 Z1) (X2 Y2 Z2) (X3 Y3 Z3) … (Xn Yn Zn))

 

A toi de traité cette valeur en retour, avec une boucle et les lignes de code donné par Didier cela ne devrai pas poser trop de problème pour écrire cela dans un fichier txt..

 

A+

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Re maxwell85,

 

serai pas possible qu'il extrait uniquement les coordonées des intersection

et le met sous cette forme

-0,0.0,0.0,0

-1,1.1,2.1,3

-2,1.2,2.2,3

- X . Y . Z .....

Je te propose le code suivant cela devrait répondre à ton besoin on doit pouvoir faire mieux, j’ai été au plus simple et au plus rapide pour moi (c'est la pose déjeuné).

 

 

A+ Bruno

(Ps : j’ai préféré l’espace au point comme séparateur)

 

Le code principal

(defun c:FichInter (/ Lpt fich)
 (cond	((setq Lpt (bv:ListInters (ssget))) ; à affiner suivant besoin
 (setq fich
	(open
	  (getfiled "Créez ou sélectionnez un fichier" "" "txt" 33)
	  "a"
	)
 )
 (foreach pt Lpt
   (write-line
     (strcat (rtos (car pt) 2 3)
	     " "
	     (rtos (cadr pt) 2 3)
	     " "
	     (rtos (caddr pt) 2 3)
     )
     fich
   )
 )
 (close fich)
)
 )
 (princ)
)

 

 

Les routines associées

;; Transforme une liste de coordonnées en liste de point
;; Argument: Une liste du type (x1 y1 z1 x2 y2 z2 x3 y3 z3 ...)
;; Retourne: Une liste du type ((x1 y1 z1) (x2 y2 z2) (x3 y3 z3) ...)
;;                        soit (p1 p2 p3 ...)
;; Exemples :
;;   (bv:xyz->Pt '(x1 y1 z1 x2 y2 z2)) -> ((X1 Y1 Z1) (X2 Y2 Z2))
;;   (bv:xyz->Pt '(x1 y1 z1)) -> ((X1 Y1 Z1))
(defun bv:xyz->Pt (L)
 (if L
   (cons (list (car L) (cadr L) (caddr L))
  (bv:xyz->Pt (cdddr L))
   )
 )
)

;; matches (renvoie les combinaisons 2 à 2 sans répétition).
;; Argument: Une liste du type (A B C D)
;; Retourne: Une liste du type ((A B) (A C) (A D) (B C) (B D) (C D))
(defun bv:matches (L)
 (if (cdr L)
   (append (mapcar '(lambda (x) (list (car L) x)) (cdr L))
    (bv:matches (cdr L))
   )
 )
)

;; Extrait du fichier Listes.lsp
;; REMOVE_DOUBLES - Auteur (gile)
;; Suprime tous les doublons d'une liste
(defun remove_doubles (lst)
 (if lst
   (cons (car lst) (remove_doubles (vl-remove (car lst) lst)))
 )
)

;; -----------------------------------------------------------------------------
;; Liste toutes les intersections présentent dans le jeu de sélection
;; (Avec suppression des points en doublons)
;; -----------------------------------------------------------------------------
;; Argument: Un jeu de sélection du type <Selection set: 2a>
;; Retourne: Une liste de point du type ((x1 y1 z1) (x2 y2 z2) (x3 y3 z3) ...)
 (defun bv:ListInters (ss / lst)
   (cond
     (ss
      (vlax-for obj (vla-get-activeselectionset
	       (vla-get-activedocument (vlax-get-acad-object))
	     )
 (setq lst (cons obj lst))
      )
      (remove_doubles
 (apply
   'append
   (mapcar '(lambda (x)
	      (bv:xyz->Pt
		(vlax-invoke (car x) 'IntersectWith (cadr x) 0)
	      )
	    )
	   (bv:matches lst)
   )
 )
      )
     )
   )
 )

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Merci ça marche

 

J’en suis heureux juste une dernière chose, pour info et faire suite à une discussion avec Patrick_35 ici, il serait visiblement préférable (plus stable) d’utiliser cette version de la sous routine bv:ListInters

 

(defun bv:ListInters (ss / lst sel)
 (cond
   (ss
    (vlax-for obj
       (setq
	 sel (vla-get-activeselectionset
	       (vla-get-activedocument (vlax-get-acad-object))
	     )
       )
      (setq lst (cons obj lst))
    )
    (vla-delete sel)
    (remove_doubles
      (apply
 'append
 (mapcar
   '(lambda (x)
      (bv:xyz->Pt
	(vlax-invoke (car x) 'IntersectWith (cadr x) 0)
      )
    )
   (bv:matches lst)
 )
      )
    )
   )
 )
)

Apprendre => Prendre => Rendre

Lien vers le commentaire
Partager sur d’autres sites

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • 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é