Joindre polylignes 3D

[lecrabe]

Hello

 

En effet cette routine de Gilles "plante grave" sur mon MAP 2013 US/English !

 

Je te propose une autre routine (ecrite par qui ?) qui marche bien !!

 

lecrabe

 

;;; 3DPOLYJOIN - 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é.
;;; Version 1.0
;;; NOTA : Ne conserve ni les arcs ni les largeurs des lwpolylignes d'origine.

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


;;************************ 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 erreur (msg)
(if (or
(= msg "Fonction annulée")
(= msg "quitter / sortir abandon")
)
(princ)
(princ (strcat "\nErreur: " msg))
)
(command)
(setq *error* m:err
m:err nil
)
(princ)
)

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

(setq m:err *error*
*error* erreur
)

;; 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 . "<or")
(0 . "LINE")
(-4 . "<and")
(0 . "POLYLINE")
(70 . 8)
(-4 . "and>")
(-4 . "<and")
(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")
(entmake (list '(0 . "POLYLINE")
'(70 . 8)
(cons 8 (val_dxf 8 ent))
(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) '(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."
)
)

;; Restauration de l'environnement initial
(setq *error* m:err
m:err nil
)
(princ)
) 

[daemge]

Bonjour et merci

 

je vais tester ça au plus vite

 

Bonne journée