Joindre polylignes 3D

[(gile)]

Suite à des sujets récents sur les modifications de polylignes 3D, ici ou là, j'ai peaufiné un LISP au fonctionnement similaire à l'option Joindre de la commande PEDIT, mais pour les polylignes 3D.

 

Il crée est une polyligne 3D a partir des objets sélectionnés (lignes, polylignes 3D ou lwpolylignes) s'il sont jointifs.

NOTA : ne conserve pas les arcs et les largeurs des lwpolylignes.

 

Pour les utilisateurs des logiciels qui ne reconnaissent pas les fonctions vl-*, il est possible de remplacer vl-remove-if-not, vl-member-if, vl-remove, par les fonctions remove-if-not, member-if, remove, définies ici.

 

NOUVELLE VERSION 05/05/06

La polyligne créée hérite des propriétés (calque, type de lignes, couleur) du premier objet sélectionné.

 

On peut aussi le télécharger directement ou à partir des Téléchargements proposées par les membres.

 

Nouvelle version : correction d'une erreur signalée par Bonuscad

 

Une version Visual LISP existe aussi en téléchargement sur cette page

 

;;; Join3dPoly - 05/02/06 -
;;; Joint au premier objet sélectionné les objets suivants s'ils sont jointifs.
;;; Fonctionne avec les lignes et polylignes ouvertes (lw ou 3D).
;;; La polyligne 3D créée hérite des propriétés (calque, couleur, type de ligne)
;;; du premier objet sélectionné.
;;;
;;; NOTA : Ne conserve ni les arcs ni les largeurs des lwpolylignes d'origine.

(defun c:Join3dPoly (/
	     ;; Fonctions
	     val_dxf   line_pts	 3dpoly_pts	     lwpoly_pts
	     butlast   *error*
	     ;;Variables
	     fltr      ent	 pts	   pt	     ss
	     cnt       e_lst	 l_lst	   sub_lst lay
	    )


 ;;************************ SOUS ROUTINES ************************;;

 ;; Valeur du code dxf d'une entité (ename)
 (defun val_dxf (code ent)
   (cdr (assoc code (entget ent)))
 )

 ;; Liste des extrémités d'une ligne
 (defun line_pts (ent)
   (list (val_dxf 10 ent) (val_dxf 11 ent))
 )

 ;; Liste des sommets d'une polyligne 3D
 (defun 3dpoly_pts (ent / pt pts)
   (while (setq pt (val_dxf 10 (entnext ent)))
     (setq ent	(entnext ent)
    pts	(cons pt pts)
     )
   )
   pts
 )

 ;; Liste des sommets d'une lwpolyligne (dans le SCG)
 (defun lwpoly_pts (ent)
   (mapcar
     '(lambda (pt)
 (trans (list (car pt) (cadr pt) (val_dxf 38 ent)) ent 0)
      )
     (mapcar
'cdr
(vl-remove-if-not
  '(lambda (x) (= (car x) 10))
  (entget ent)
)
     )
   )
 )

 ;; Liste sans le dernier élément
 (defun butlast (lst)
   (reverse (cdr (reverse lst)))
 )

 ;; Redéfinition de *error*
 (defun *error*	(msg)
   (if	(or
  (= msg "Fonction annulée")
  (= msg "quitter / sortir abandon")
)
     (princ)
     (princ (strcat "\nErreur: " msg))
   )
   (command)
   (princ)
 )

 ;;********************* FONCTION PRINCIPALE *********************;;

 ;; Sélection du premier objet
 (while
   (not
     (and
(setq ent
       (car (entsel "\nSélectionnez une ligne ou une polyligne: ")
       )
)
(or (= (val_dxf 0 ent) "LINE")
    (and (= (val_dxf 0 ent) "POLYLINE")
	 (= (val_dxf 70 ent) 8)
    )
    (and (= (val_dxf 0 ent) "LWPOLYLINE")
	 (= (val_dxf 70 ent) 0)
    )
)
     )
   )
 )

 ;; Sélection des objets à joindre
 (prompt
   "\nSélectionnez les lignes et polylignes à joindre"
 )
 (setq	ss (ssget '((-4 . "[b]		    (0 . "LINE")
	    (-4 . "[b]		    (0 . "POLYLINE")
	    (70 . 8)
	    (-4 . "and>")
	    (-4 . "[b]		    (0 . "LWPOLYLINE")
	    (70 . 0)
	    (-4 . "and>")
	    (-4 . "or>")
	   )
   )
 )

 ;; PTS : liste des sommets du premier objet sélectionné
 (setq	pts
 (cond
   ((= (val_dxf 0 ent) "LINE") (line_pts ent))
   ((= (val_dxf 0 ent) "POLYLINE") (3dpoly_pts ent))
   ((= (val_dxf 0 ent) "LWPOLYLINE") (lwpoly_pts ent))
 )
 )

 ;; L_LST : liste constiuée de listes contenant le nom d'entité et les sommets
 ;; pour chaque objet du jeu de sélection (exepté le premier objet sélectionné)
 (setq cnt 0)
 (while (setq ele (ssname ss cnt))
   (if	(not (equal ent ele))
     (setq l_lst
     (cons
       (cons ele
	     (cond
	       ((= (val_dxf 0 ele) "LINE") (line_pts ele))
	       ((= (val_dxf 0 ele) "POLYLINE") (3dpoly_pts ele))
	       ((= (val_dxf 0 ele) "LWPOLYLINE") (lwpoly_pts ele))
	     )
       )
       l_lst
     )
     )
   )
   (setq cnt (1+ cnt))
 )

 ;; Boucle tant qu'un objet a une extrémité commune avec celles de la liste PTS
 (while
   (setq
     sub_lst (vl-member-if
	'(lambda (x)
	   (or (equal (cadr x) (car pts) 1e-009)
	       (equal (last x) (car pts) 1e-009)
	       (equal (cadr x) (last pts) 1e-009)
	       (equal (last x) (last pts) 1e-009)
	   )
	 )
	l_lst
      )
   )

    ;; Ajout, dans l'ordre, des sommets de chaque objet jointif à PTS
    (cond
      ((equal (cadar sub_lst) (car pts) 1e-009)
(setq pts (append (reverse (cddar sub_lst)) pts))
      )
      ((equal (last (car sub_lst)) (car pts) 1e-009)
(setq pts (append (butlast (cdar sub_lst)) pts))
      )
      ((equal (cadar sub_lst) (last pts) 1e-009)
(setq
  pts (reverse
	(append (reverse (cddar sub_lst)) (reverse pts))
      )
)
      )
      ((equal (last (car sub_lst)) (last pts) 1e-009)
(setq
  pts (reverse
	(append (butlast (cdar sub_lst)) (reverse pts))
      )
)
      )
    )

    ;; Suppression de l'objet traité de la liste L_LST
    ;; Constitution de E_LST avec les noms d'entités de ces objets.
    (setq l_lst (vl-remove (car sub_lst) l_lst)
   e_lst (cons (caar sub_lst) e_lst)
    )
 )					; Fin de la boucle

 (setq	cnt   (length e_lst)		; Compte des objets ajoutées
e_lst (cons ent e_lst)		; Ajout de la première entité à E_LST
 )

 ;; Créaton de la polyligne
 (command "_regen")
 (setq lay (assoc 8 (entget ent)))
 (entmake (list '(0 . "POLYLINE")
	 '(70 . 8)
	 lay
	 (if (val_dxf 6 ent)
	   (cons 6 (val_dxf 6 ent))
	   (cons 6 "BYLAYER")
	 )
	 (if (val_dxf 62 ent)
	   (cons 62 (val_dxf 62 ent))
	   (cons 62 256)
	 )
   )
 )
 (mapcar
   'entmake
   (mapcar '(lambda (pt) (list '(0 . "VERTEX") (cons 10 pt) lay '(70 . 32)))
    pts
   )
 )
 (entmake '((0 . "SEQEND")))
 (mapcar 'entdel e_lst)		; Suppression des objets transformés
 (prompt (strcat "\n"
	  (itoa cnt)
	  " objets ont été ajoutés à la polyligne 3D."
  )
 )
 (princ)
)

[Edité le 5/2/2006 par (gile)]

 

[Edité le 20/5/2008 par (gile)]

[lecrabe]

hello (gile)

 

Apres avoir copié/collé puis chargé ton Lisp, j'ai l'erreur suivante:

 

; erreur: cdrs supplémentaire dans la paire pointée en entrée

 

Aurais je loupé le Copier/Coller ???

 

Merci d'avance, Le Decapode

 

STOP STOP, il faut que je corrige les ESPACEs et

 

Sorry, sorry :P

 

[Edité le 3/2/2006 par lecrabe]

[(gile)]

Mille excuses aux premiers lecteurs. :mad2:

 

J'avais oublié de mettre des espaces après les signes (à supprimer après collage) ce qui provoque une erreur d'affichage dans CADxp.

[lecrabe]

 

ReBonjour (gile)

 

SVP peux tu m'envoyer le BON Lisp sur mon adresse courriel ?

 

cadxp@hotmail.fr

 

Merci d'avance, Le Decapode

 

[(gile)]

À "lecrabe" :

 

Je t'ai envoyé le LISP.

 

À tous :

 

Le LISP ci-dessus fonctionne correctement si, après l'avoir collé dans le bloc-note, on supprime les espaces après les signes .

[mikL44]

Nickel, ca marche super

 

Bravo

 

 

[lecrabe]

 

ReBonjour

 

OK Merci (gile), j'ai testé mais j'ai un petit problème:

 

J'ai dessiné une suite d'éléments jointifs qui sont (dans l'ordre):

lignes 2D, polyligne 3D (qui finit à Z=-50), polyligne 2D (qui commence à Z=-50)

 

Ta routine fonctionne en sélectionnant la 1ere ligne, puis tous les éléments suivants ...

 

Mais elle ne joint pas la dernière Polyligne 2D à TA 3DPOLY générée

par ta routine ! :o

 

BIen entendu la Polyligne 2D est accroché à la fin de la polyligne 3D.

 

Porque ???

 

Le Decapode

 

 

[(gile)]

Merci à toi, cher décapode, d'avoir testé en profondeur et soulevé un problème que, dans mon enthousiasme, j'avais occulté.

 

En effet, les sommets des lwpolylignes sont définis, en dxf, par des points 2D dans le SCO. Leurs traductions dans le LISP pour comparaison avec les autres points était incomplète.

 

Le problème est en partie réparé (je modifie à nouveau le code ci-dessus). En partie, parceque j'ai encore un soucis si la lwpolyligne a été créée dans un SCU non parallèle au SCG, soucis que je ne desespère pas solutionner rapidement.

[mikL44]

J ai fait un ptit iso en 3D avec que des lignes ca marche super.

Par contre des que je raccorde ces lignes avec un rayon, et que je convertis les arcs obtenus en polyligne, et que ensuite je lance join3dpoly, et bien la ca marche plus.

 

Pour info tout les objets que j essaie de joindre sont des polylignes.

 

http://img212.imageshack.us/img212/8611/iso4xq.jpg

 

 

 

 

[mikL44]

oups excuse j avais pas vu ton dernier post

[(gile)]

Çà y est, le problème soulevé par lecrabe semble résolu.

 

Çà devrait marcher quelque soit le SCU dans lequel ont été dessiné les lwpolylignes et quelque soit le SCU courant.

 

J'ai été obligé de mettre une tolérance pour la comparaison des points (de l'ordre du milliardième), la traduction des points du SCO vers le SCG altèrant un peu la précision d'AutoCAD.

 

Pour Boris :

 

Il est bien spécifié dans le premier message que les arcs des lwpolylignes ne sont pas conservés dans la polyligne 3D finale.

[mikL44]

ok ok désolé, j avais mal lu.

 

merci gile

[(gile)]

C'est moi qui remercie les testeurs :)

 

Grace à vos remarques pertinentes le LISP a pu être corrigé et ammélioré.

[(gile)]

Encore une petite amélioration.

 

La polyligne créée herite désormais des propriétés (calque, type de ligne, couleur) du premier objet sélectionné.

 

Le code du premier message a été modifié.

 

On peut aussi le télécharger directement ou à partir des Téléchargements proposées par les membres.

 

[Edité le 5/2/2006 par (gile)]

[lecrabe]

 

Bonjour (gile)

 

Y a pas à dire, le GIlou c le meilleur !!! :) :D :cool:

 

Le Decapode "admiratif"

 

[(gile)]

Y a pas à dire, le GIlou c le meilleur !!!

 

Merci :red:

 

Le "novice" que je suis est très touché par ce compliment venant du puit de connaissance que peut être un aussi ancien utilisateur d'AutoCAD que ce cher Décapode.

 

"Le meilleur", je ne pense pas, il y a des lipeurs sur CADxp de qui j'ai encore beaucoup à apprendre.

[bonuscad]

Je reconnais que ta routine est bien aboutie.

 

Tu as le gros mérite de commenter tes codes, ce qui n'est pas du tout mon cas :mad:

 

Et puis MERCI pour ta générosité, que dire de plus ;)

 

Je conserve parmi ma bibliothèque épisodique, mais bien utile quand le cas se présente.

 

Donc peut être commentaires dans le futur....

[lecrabe]

 

Bonsoir (gile) & Bonuscad

 

On est toujours le meilleur à un instant T :) :D :cool:

 

Mais combien va durer cet instant T , c'est toute la question ! ;)

 

Je vous admire (avec bien d'autres Lispeurs / V-Lispeurs / VBAistes / C++ARXistes

de ce forum) car je ne suis pas du tout (ou du moins je ne suis PLUS)

développeur / programmeur :casstet:

 

Le Decapode (humble testeur)

 

[bonuscad]

Hello (gile),

 

Donc peut être commentaires dans le futur....

 

Hé bien voilà, cela arrive.

 

Je fais en ce moment une utilisation intensive de ta routine, elle fonctionne bien et me permet de réaliser ce que je veux.

 

Seulement il y a un problème non négligeable: ta routine génère énormément d'erreurs (qui sont cependant corrigé par la la commande CONTROLE, _AUDIT)

 

Un extrait du genre d'erreur retourné.

 

AcDb3dPolylineVertex(8CAB) layer != owner's set to owner's

AcDb3dPolylineVertex(8CAB) n'a pas été réparé.

AcDb3dPolylineVertex(8CAC) layer != owner's set to owner's

AcDb3dPolylineVertex(8CAC) n'a pas été réparé.

AcDb3dPolylineVertex(8CAD) layer != owner's set to owner's

AcDb3dPolylineVertex(8CAD) n'a pas été réparé.

AcDb3dPolylineVertex(8CAE) layer != owner's set to owner's

AcDb3dPolylineVertex(8CAE) n'a pas été réparé.

AcDb3dPolylineVertex(8CAF) layer != owner's set to owner's

AcDb3dPolylineVertex(8CAF) n'a pas été réparé.

AcDb3dPolylineVertex(8CB0) layer != owner's set to owner's

AcDb3dPolylineVertex(8CB0) n'a pas été réparé.

 

Contrôle des blocs

 

 

1 blocs contrôlés

 

Nombre total d'erreurs trouvées 11829, corrigées 0

 

0 objets effacés

 

 

Ceci pour une seule polyligne3D de 11829 sommets et j'en ai environ 700 à traiter, sachant que par la suite, j'y rajoute encore des Xdatas.

 

Mon fichier 3D fait actuellement 124500Ko et je ne suis pas encore rendu au bout, environ 2/3 de réalisé, donc je te dis pas le temps que dure l'audit (c'est un peu pénalisant), déjà que les sauvegardes automatiques commencent aussi à me gonfler car tout ça n'est pas instantané. :casstet:

 

NB: Je travaille essentiellement dans le SCG.

 

Je pense que ce problème vient de la partie (entmake) faite sur les Vertex, tu as omis le code dxf du layer. Je n'ai pas essayer de corriger, je t'informe d'abords... ;)

[(gile)]

Bien vu Bonuscad.

 

Les erreurs semblent bien venir de là, je vais corriger le code de ce sujet.

 

En fait, je n'utilise plus cette routine, j'en ai écris une autre (en Visual LISP), qui devrait aussi "mouliner" plus vite pour retrouver les sommets contigus.

Cette version ne demande qu'un jeu de sélection et créé une nouvelle polyligne avec les propriétés courantes du dessin.

C'est cette version qui est en téléchargement sur cette page

 

;; Join3dPoly (gile)
;; Joint les objets sélectionnés en une polyligne 3d s'ils sont jointifs
;; La polyligne est créée avec les propriétés courantes (calque, couleur, ...)

(defun c:Join3dPoly (/ Space ss lst plst olst n 3p)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )
 (setq	Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace *acdoc*)
	(vla-get-ModelSpace *acdoc*)
      )
 )
 (while (not (ssget '((-4 . "[b]		       (0 . "LINE")
	       (-4 . "[b]		       (0 . "POLYLINE")
	       (70 . 8)
	       (-4 . "AND>")
	       (-4 . "[b]		       (0 . "LWPOLYLINE")
	       (70 . 0)
	       (-4 . "AND>")
	       (-4 . "OR>")
	      )
      )
 )
 )
 (vlax-for obj	(setq ss (vla-get-ActiveSelectionSet *acdoc*))
   (cond
     ((= (vla-get-ObjectName obj) "AcDbLine")
      (setq lst (cons
	   (cons obj
		 (list (vlax-get obj 'StartPoint)
		       (vlax-get obj 'EndPoint)
		 )
	   )
	   lst
	 )
      )
     )
     ((= (vla-get-ObjectName obj) "AcDbPolyline")
      (setq lst (cons (cons obj (PlinePoints obj)) lst))
     )
     ((= (vla-get-ObjectName obj) "AcDb3dPolyline")
      (setq lst
      (cons
	(cons obj (3d-coord->pt-lst (vlax-get obj 'Coordinates)))
	lst
      )
      )
     )
   )
 )
 (while (and lst (    (setq plst (cdar lst)
  olst (list (caar lst))
  lst  (cdr lst)
  n    0
   )
   (while (and lst (      (cond
((equal (cadar lst) (last plst) 1e-9)
 (setq plst (append plst (cddar lst))
       olst (cons (caar lst) olst)
       lst  (cdr lst)
       n    0
 )
)
((equal (last (cdar lst)) (car plst) 1e-9)
 (setq plst (append (cdar lst) (cdr plst))
       olst (cons (caar lst) olst)
       lst  (cdr lst)
       n    0
 )
)
((equal (cadar lst) (car plst) 1e-9)
 (setq plst (append (reverse (cdar lst)) (cdr plst))
       olst (cons (caar lst) olst)
       lst  (cdr lst)
       n    0
 )
)
((equal (last (cdar lst)) (last plst) 1e-9)
 (setq plst (append plst (cdr (reverse (cdar lst))))
       olst (cons (caar lst) olst)
       lst  (cdr lst)
       n    0
 )
)
(T
 (setq lst (append (cdr lst) (list (car lst)))
       n   (1+ n)
 )
)
     )
   )
 )
 (if (and (= 1 (setq n (length olst))) (    (princ "\nObjets non jointifs.")
   (progn
     (vla-StartUndoMark *acdoc*)
     (vlax-invoke Space 'add3dPoly (apply 'append plst))
     (if (= 1 n)
(princ "\n1 objet a été transformé en polyligne 3d.")
(princ (strcat "\n"
	       (itoa n)
	       " objets ont été joints en une polyligne 3d."
       )
)
     )
     (mapcar 'vla-delete olst)
     (vla-EndUndoMark *acdoc*)
   )
 )
 (vla-delete ss)
 (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))
   )
 )
)

;;; PlinePoints
;;; Retourne la liste des sommets (coordonnées SCG) de la polyligne (ename ou vla-object)

(defun PlinePoints (pl / sub)
 (vl-load-com)
 (or (= (type pl) 'VLA-OBJECT)
     (setq pl (vlax-ename->vla-object pl))
 )

 (defun sub (l e n)
   (if	l
     (cons (trans (list (car l) (cadr l) e) n 0)
    (sub (cddr l) e n)
     )
   )
 )

 (sub (vlax-get pl 'Coordinates)
      (vla-get-Elevation pl)
      (vlax-get pl 'Normal)
 )
) 

[bonuscad]

C'est cette version qui est en téléchargement sur cette page

 

(gile), tu te mélanges les pinceaux, sur ta page, c'est l'ancienne version (qui comporte toujours le bug d'ailleurs), t'aurais du changer le nom de la fonction... ;)

Ta bibliothèque devient tellement étoffé, qu'il va falloir engagé une jolie bibliothécaire pour la gérer :D

 

Donc le code au début du fil fonctionne bien (c'est celui qui me convient le mieux)

 

Le code en VL fonctionne bien aussi, mais ne me convient pas, même si plus rapide:

 

créé une nouvelle polyligne avec les propriétés courantes du dessin

 

Je trouve la 1ere fonction fonction plus proche de pedit (prendre les propriété de la 1ère entité sélectionné).

[(gile)]

Salut Bonuscad,

 

Non, c'est bien la dernière version, il est parfois nécessaire de faire "Actualiser la page courante" sur la page du fichier LISP.

 

Quand j'aurais le temps, je ferais une version vlisp avec le même comportement que l'ancienne (comme PEDIT).

[bonuscad]

Salut (gile)

 

Effectivement c'est bon, je n'avais pas pensé au cache du navigateur....

 

Quand j'aurais le temps

 

Prends tout ton temps, tu en fais déjà beaucoup, je me demande d'ailleurs comment tu peux consacrer autant de temps au développement, surtout pour rendre service aux demandes du forum.

 

C'est pas une critique, j'admire ton investissement. Car à part ton enrichissement personnel, je doute d'une autre sorte d'enrichissement.

 

Respect.

[(gile)]

Salut,

 

je me demande d'ailleurs comment tu peux consacrer autant de temps au développement,

Disons que je vis ça comme une passion, un jeu.

 

Car à part ton enrichissement personnel, je doute d'une autre sorte d'enrichissement.

Effectivement, ça ne me rapporte rien, mais quel plaisir de pouvoir te donner un coup de main, par exemple.

 

 

Une version au fonctionnement semblable à PEDIT (choix d'un premier objet, puis de objets à lui joindre.

 

;;; Join3dPoly (gile)
;;; Fonctionnement semblable à PEDIT option Joindre
;;; Joint au premier objet sélectionné les objets suivants s'ils sont jointifs.
;;; Fonctionne avec les lignes et polylignes ouvertes (lw ou 3D).
;;; La polyligne 3D créée hérite des propriétés (calque, couleur, type de ligne, épaisseur)
;;; du premier objet sélectionné.
;;; (version révisée 24/05/08)

(defun c:Join3dPoly (/ *error* Space ent obj ss lst plst olst n 3dpl)
 (vl-load-com)
 (or *acdoc*
     (setq *acdoc* (vla-get-ActiveDocument (vlax-get-acad-object)))
 )

 (defun *error* (msg)
   (or	(= msg "Fonction annulée")
(princ (strcat "\nErreur: " msg))
   )
   (and ent (redraw ent 4))
   (vla-EndUndoMark *acdoc*)
   (princ)
 )

 (setq	Space (if (= (getvar "CVPORT") 1)
	(vla-get-PaperSpace *acdoc*)
	(vla-get-ModelSpace *acdoc*)
      )
 )
 (while
   (not
     (and
(setq ent
       (car (entsel "\nSélectionnez une polyligne ou une ligne: ")
       )
)
(setq obj (vlax-ename->vla-object ent))
(member	(vla-get-ObjectName obj)
	'("AcDbLine" "AcDbPolyline" "AcDb3dPolyline")
)
     )
   )
    (princ "\nEntité non valide.")
 )
 (redraw ent 3)
 (while
   (not
     (setq ss (ssget '((-4 . "[b]			(0 . "LINE")
		(-4 . "[b]			(0 . "POLYLINE")
		(70 . 8)
		(-4 . "AND>")
		(-4 . "[b]			(0 . "LWPOLYLINE")
		(-4 . "[b]			(-4 . "&")
		(70 . 1)
		(-4 . "NOT>")
		(-4 . "AND>")
		(-4 . "OR>")
	       )
       )
     )
   )
 )
 (redraw ent 4)
 (vlax-for o (setq ss (vla-get-ActiveSelectionSet *acdoc*))
   (setq lst (cons o lst))
 )
 (setq	lst
 (mapcar
   (function
     (lambda (o)
       (cond
	 ((= (vla-get-ObjectName o) "AcDbLine")
	  (cons	o
		(list (vlax-get o 'StartPoint)
		      (vlax-get o 'EndPoint)
		)
	  )
	 )
	 ((= (vla-get-ObjectName o) "AcDbPolyline")
	  (cons o (PlinePoints o))
	 )
	 ((= (vla-get-ObjectName o) "AcDb3dPolyline")
	  (cons o (3d-coord->pt-lst (vlax-get o 'Coordinates)))
	 )
       )
     )
   )
   (cons obj (vl-remove obj lst))
 )
 )
 (setq	plst (cdar lst)
olst (list (caar lst))
lst  (cdr lst)
n    0
 )
 (while (and lst (    (cond
     ((equal (cadar lst) (last plst) 1e-9)
      (setq plst (append plst (cddar lst))
     olst (cons (caar lst) olst)
     lst  (cdr lst)
     n	  0
      )
     )
     ((equal (last (cdar lst)) (car plst) 1e-9)
      (setq plst (append (cdar lst) (cdr plst))
     olst (cons (caar lst) olst)
     lst  (cdr lst)
     n	  0
      )
     )
     ((equal (cadar lst) (car plst) 1e-9)
      (setq plst (append (reverse (cdar lst)) (cdr plst))
     olst (cons (caar lst) olst)
     lst  (cdr lst)
     n	  0
      )
     )
     ((equal (last (cdar lst)) (last plst) 1e-9)
      (setq plst (append plst (cdr (reverse (cdar lst))))
     olst (cons (caar lst) olst)
     lst  (cdr lst)
     n	  0
      )
     )
     (T
      (setq lst (append (cdr lst) (list (car lst)))
     n	 (1+ n)
      )
     )
   )
 )
 (if (and (= 1 (setq n (length olst))) (    (princ "\nObjets non jointifs.")
   (progn
     (vla-StartUndoMark *acdoc*)
     (setq 3dpl (vlax-invoke Space 'add3dPoly (apply 'append plst)))
     (foreach prop '(Color	    Layer	  Linetype
	      LinetypeScale Lineweight	  TrueColor
	     )
(if (and (vlax-property-available-p obj prop)
	 (vlax-property-available-p 3dpl prop T)
    )
  (vlax-put 3dpl prop (vlax-get obj prop))
)
     )
     (if (= 1 n)
(princ "\n1 objet a été transformé en polyligne 3d.")
(princ (strcat "\n"
	       (itoa n)
	       " objets ont été joints en une polyligne 3d."
       )
)
     )
     (mapcar 'vla-delete olst)
     (vla-EndUndoMark *acdoc*)
   )
 )
 (vla-delete ss)
 (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))
   )
 )
)

;;; PlinePoints
;;; Retourne la liste des sommets (coordonnées SCG) de la polyligne (ename ou vla-object)

(defun PlinePoints (pl / sub)
 (vl-load-com)
 (or (= (type pl) 'VLA-OBJECT)
     (setq pl (vlax-ename->vla-object pl))
 )

 (defun sub (l e n)
   (if	l
     (cons (trans (list (car l) (cadr l) e) n 0)
    (sub (cddr l) e n)
     )
   )
 )

 (sub (vlax-get pl 'Coordinates)
      (vla-get-Elevation pl)
      (vlax-get pl 'Normal)
 )
) 

 

[Edité le 24/5/2008 par (gile)]

[daemge]

Bonjour

 

je tente de faire fonctionner le lisp avec autocad map2012 et ça plante à chaque fois ?

 

est ce un probleme de version ?

 

Merci pour vos réponses

 

bonne journée