Découper

[Matt666]

Salut !

Petite commande rigolote pour le week-end :)

Permet aussi de voir une utilisation de la fonction inters...

Trouvée sur un site, et améliorée, avec qqs explications...

 

;;; Sélectionne une ligne de base (ou tranchant) puis ajuste toutes les
;;; lignes sélectionnées ensuite.

(defun C:DECOUPE ()
    (setq cmdecho (getvar "CMDECHO"))                                                             ;;; Etat de la variable cmdecho
    (setvar "CMDECHO" 0)                                                                          ;;; Modification de la variable cmdecho
    (command "_undo" "D")                                                                         ;;; Début du jeu d'annulation
    (if (and 
              (setq ent (car (entsel "\nSélectionner la ligne de base : ")))                      ;;; Ligne de base
              (eq (cdr (assoc 0 (entget ent))) "LINE")                                            ;;; Si entité ligne de base est une ligne
         )
         (progn
              (redraw ent 3)                                                                      ;;; Mettre en surbrillance ligne de base
              (prompt "\nSélectionner les lignes à découper : ")                                  ;;; Message
              (if (setq sel (ssget '((0 . "LINE"))))                                              ;;; Lignes à découper
                   (progn
                        (repeat (setq cn (sslength sel))                                          ;;; Début de la boucle
                             (setq lentl (entget (ssname sel (setq cn (1- cn)))))                 ;;; Nom de la ligne à découper
                             (if (and 
                                       (/= (ssname sel cn) ent)
                                       (setq lint (inters                                         ;;; Trouve l'intersection des deux lignes
                                                 (cdr (assoc 10 (entget ent)))                    ;;; 1er pt ligne de base
                                                 (cdr (assoc 11 (entget ent)))                    ;;; 2èm pt ligne de base
                                                 (cdr (assoc 10 lentl))                           ;;; 1er pt ligne à découper
                                                 (cdr (assoc 11 lentl))                           ;;; 2èm pt ligne à découper
                                                 nil                                              ;;; Lignes considérées comme des droites
                                       ))
                                  )
                                  (if (<                                                          ;;; Sens de la découpe
                                            (distance lint (cdr (assoc 10 lentl)))
                                            (distance lint (cdr (assoc 11 lentl)))
                                       )
                                       (entmod (subst (cons 10 lint) (assoc 10 lentl) lentl))     ;;; Modifie l'entité dans un sens
                                       (entmod (subst (cons 11 lint) (assoc 11 lentl) lentl))     ;;; Modifie l'entité dans un autre sens
                                  )
                                  (if (and 
                                            (not (eq (ssname sel cn) ent))                        ;;; Si pas d'intersection possible, parallèle.
                                            (not lint)
                                       )
                                       (princ "\nLignes parallèles.")
                                       (if (eq (ssname sel cn) ent)                               ;;; Si trouve ligne de base dans ligne à découper,
                                            (setq tot (1- (sslength sel)))                        ;;; Enlever du nombre de lignes à découper.
(setq tot (sslength sel))
                                       )
                                  )
                             )
                             
                        )
                        (if (< tot 2)
                             (princ (strcat "\n" (itoa tot) " ligne découpée." ))                 ;;; Si 1 ou 0 ligne découpée, phrase au singulier
                             (princ (strcat "\n" (itoa tot) " lignes découpées." ))               ;;; Si plus de deux, phrase au pluriel
                        )
                   )
              )
              (redraw ent 4)                                                                      ;;; Déscativer la surbrillance de la ligne de base
         )
    )
    (command "_UNDO" "F")                                                                         ;;; Fin du jeu d'annulation
    (setvar "CMDECHO" cmdecho)                                                                    ;;; RAZ variable cmdecho
    (princ)
)

 

Voilà !!!

Bon Week-end à tous.

Matt.

 

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