purge lignes

[Matt666]

Monopolisation du forum là... Ca va plus !!!

 

Encore un truc...

 

Suite à une discussion ici, j'ai eu une petite idée d'un lisp :

Purger les lignes superposées en fonction d'une sélection.

 

J'ai commencé, ça donne ça :

;;; LINEARP Retourne T si tous les points de la liste sont alignés
;;; Lisp de GILE
(defun linearp (lst)
    (cond
         ((= 2 (length lst)) T)
         ((or (equal (vec1 (car lst) (cadr lst))
                        (vec1 (car lst) (caddr lst))
                        1e-009
                   )
                   (equal (vec1 (car lst) (cadr lst))
                        (vec1 (caddr lst) (car lst))
                        1e-009
                   )
              )
              (linearp (cdr lst))
         )
    )
)

;;; VEC1 Retourne le vecteur normé (1 unité) de p1 à p2 (nil si p1 = p2)
;;;Lisp de GILE
(defun vec1 (p1 p2)
    (if (not (equal p1 p2 1e-009))
         (mapcar '(lambda (x1 x2)
                   (/ (- x2 x1) (distance p1 p2))
              )
              p1
              p2
         )
    )
)
;;;Efface les lignes superflues
(defun c:SURFLU ()
    (cond ((setq sel (ssget '((0 . "LINE"))))
              (setq cn 0)
              (while (setq entity (ssname sel (setq cn (1+ cn))))
                   (setq
                        lst1 nil
                        lst1 (cons (cdr (assoc 10 (entget entity))) lst1)
                        lst1 (cons (cdr (assoc 11 (entget entity))) lst1)
                        lst3 nil
                   )
                   (repeat (setq cn2 (sslength sel))
                        (setq 
                             entity2 (ssname sel (setq cn2 (1- cn2)))
                             lst2 nil
                             lst2 (cons (cdr (assoc 10 (entget entity2))) lst2)
                             lst2 (cons (cdr (assoc 11 (entget entity2))) lst2)
                        )
                        (if (linearp (append lst1 lst2))
                             (progn
                                  (if lst3 (setq lst3 (append lst2 lst3))(setq lst3 (append lst1 lst2)))
                                  (entdel entity2)
                                  (ssdel entity2 sel)
                             )
                        )
                   )
                   (if lst3 (progn
                             (setq 
                                  addit (mapcar '(lambda (x) (+ (car x) (cadr x) (caddr x))) lst3)
                                  pt1 (nth (position (car (sort addit '<)) addit) lst3)
                                  pt2 (nth (position (car (sort addit '>)) addit) lst3)
                             )
                             (entdel entity)
                             (entmake (list
                                       (cons 0 "LINE")
                                       (cons 10 pt1)
                                       (cons 11 pt2)
                             ))
                             (entupd (entlast))
                             (princ "\nlignes jointes.")
                   ))
              )
         )
    )
    (redraw)
    (princ)
)

 

En fin de compte le ssget retourne une liste de points qui, à la condition d'être co-linéaires sont jointes pour ne former qu'une seule ligne.

 

Le code est loin d'être concis, notamment cette chose là

(setq 
                                  addit (mapcar '(lambda (x) (+ (car x) (cadr x) (caddr x))) lst3)
                                  pt1 (nth (position (car (sort addit '<)) addit) lst3)
                                  pt2 (nth (position (car (sort addit '>)) addit) lst3)
                             )

qui retourne la coordonnée la plus grande et la plus petite... La routine met beaucoup de temps à finir son travail...

 

Alors ça fonctionne pour les lignes superposées. Par contre si deux lignes séparées d'un vide sont colinéaires, il va les joindre aussi !!

 

Voilà je cherche un moyen de lui faire comprendre de ne pas joindre les lignes non superposées et colinéaires... Et puis, en passant, d'accélérer un peu letravil à fournir !!

 

Voilà !

 

Merci !

A bientot.

 

PS : Bien sur je pourrais utiliser la commande joindre, mais ce serait trop facile ;)

 

[Edité le 12/9/2007 par Matt666]