Rechercher dans la communauté
Affichage des résultats pour les étiquettes '[résolut]'.
1 résultat trouvé
-
Création d'une boîte englobante pour plusieurs blocs avec attributs
nen a posté un sujet dans Débuter en LISP
Bonjour le forum🙂, Je sollicite votre aide pour un problème que nous rencontrons. Depuis plusieurs mois, mon collègue et moi, qui sommes de véritables novices en Lisp, travaillons sur un code ci-dessous pour créer une boîte englobante (rectangle) autour d'une sélection de blocs contenant plusieurs attributs. Nous souhaitons que cette boîte (rectangle) soit placée sur le calque "Rectangle" en couleur verte, et nous aimerions inclure une option pour demander un décalage. Nous avons essayé d'intégrer différents morceaux de code sans succès. Si quelqu'un pouvait jeter un coup d'œil à notre code, ce serait vraiment sympa😉. Merci d'avance pour votre aide ! (defun c:BoxBlocAttrib ( / ss i Ent ObjType AttribList Bbox MinPt MaxPt Pt1 Pt2 Pt3 Pt4 Decal) (setq oldcmd00 (getvar "cmdecho")) (setvar "cmdecho" 0) ;; Fonction pour décaler un point (defun DeltaXY (Pt1 DeltaX DeltaY) (list (+ (car Pt1) DeltaX) (+ (cadr Pt1) DeltaY) ) ) ;; Fonction pour calculer la boîte englobante entre deux points (defun AddToBoundingBox (bbox point) (setq MinPt (mapcar 'min (car bbox) point)) (setq MaxPt (mapcar 'max (cadr bbox) point)) (list MinPt MaxPt) ) ;; Demander la sélection des blocs (setq ss (ssget '((0 . "INSERT")))) ; Sélection des blocs (setq Decal (getdist "\nDécalage ? <10> : ")) (if (= Decal nil)(setq Decal 10)) ;; Créer ou définir le calque "Rectangle" avec une couleur verte (if (not (tblsearch "layer" "Rectangle")) (progn (command "_.-layer" "_Make" "Rectangle" "_Color" "Vert" "" "") ) (command "_.-layer" "_Set" "Rectangle" "") ) ;; Boucler sur chaque bloc sélectionné (setq i 0) (while (< i (sslength ss)) (setq Ent (ssname ss i)) (setq ObjType (cdr (assoc 0 (entget Ent)))) ; Récupérer le type d'objet ;; Initialiser la boîte englobante (setq Bbox nil) ;; Si c'est un bloc avec attributs, on récupère les attributs et leur boîte englobante (if (eq ObjType "INSERT") (progn (setq AttribList (entnext Ent)) (while (and AttribList (eq (cdr (assoc 0 (entget AttribList))) "ATTRIB")) (command "_ucs" "_Entity" AttribList) (setq Tb_list (textbox (list (cons -1 AttribList)))) (setq Pt1 (car Tb_list)) (setq Pt2 (cadr Tb_list)) (if Bbox (setq Bbox (AddToBoundingBox Bbox Pt1)) (setq Bbox (list Pt1 Pt2)) ) (setq Bbox (AddToBoundingBox Bbox Pt2)) (setq AttribList (entnext AttribList)) ) ;; Décaler les points de la boîte englobante (setq Pt1 (car Bbox)) (setq Pt1 (DeltaXY Pt1 (* Decal -1) (* Decal -1))) (setq Pt2 (cadr Bbox)) (setq Pt2 (DeltaXY Pt2 Decal Decal)) (setq Pt3 (list (car Pt1) (cadr Pt2))) (setq Pt4 (list (car Pt2) (cadr Pt1))) ;; Dessiner le rectangle sur le calque "Rectangle" (command "_layer" "_set" "Rectangle" "") (command "_rectang" Pt1 Pt2) ;; Restaurer le SCU (système de coordonnées utilisateur) (command "_ucs" "_p") ) ) ;; Passer à l'objet suivant (setq i (1+ i)) ) (setvar "cmdecho" oldcmd00) (princ) )