Diviser un objet par une selection d\'objets

[Titifonky]

Bonjour :D

 

Voici un petit programme en VLisp pour diviser un objet en selectionnant les objets coupants.

Ce programme est le resultat de l'assemblage de routines que j'ai fabriqué (groupes) ou que j'ai trouvé sur le très bon site AfraLisp (VBlisp), ce qui m'a permit de réaliser ce programme assez rapidement mais il est très lourd.

 

Comme j'utilise enormément la fonction groupe, j'ai rajouté une fonction qui ajoute les morceaux créées au groupe d'origine. La division ne fonctionne pas avec les blocs

 

 

 

(defun addgroup	(group /)
 (setq	selectionset
 listent
i 0
 )
 (while (< i (length selectionset))
   (setq entname (list (cons 340 (nth i selectionset))))
   (setq group (entmod (append group entname)))
   (setq i (1+ i))
 )
 (princ)
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun isgroup (numeroent /)
 (setq
   groupnumero
    (cdadr (member '(102 . "{ACAD_REACTORS")
	    (entget numeroent)
    )
    )
 )
 (if groupnumero
   (progn
     (setq groupdef (entget groupnumero))
     ;;test si groupnumero est bien un groupe
     (if (equal (cadr groupdef) '(0 . "GROUP"))
(setq is T)


(setq is nil)

     )
   )
   (setq is nil)
 )
)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:diva (/ ssets acadDocument newsset ctr item)

				;load the visual lisp extensions
 (vl-load-com)

				;retrieve a reference to the documents object
 (setq	acadDocument
 (vla-get-activedocument
   (vlax-get-acad-object)
 )
 )

				;retrieve a reference to the selection sets object
 (setq ssets (vla-get-selectionsets acadDocument))



 (setq entname (car (entsel "\nSelectionnez l'objet à couper : ")))

 (setq selstyle (getvar "PICKSTYLE"))
 (setvar "PICKSTYLE" 0)


 (setq obj1 (vlax-ename->vla-object entname))

				;add a new selection set
 (setq newsset (vla-add ssets "SS1"))

				;select your new selection set objects
 (princ "\nSelectionnez les objets coupants :")
 (vla-selectOnScreen
   newsset
 )

				;set the counter to zero
 (setq ctr 0)
 (setq int1 '(nil))

				;count the number of objects and loop
 (repeat (vla-get-count newsset)

				;retrieve each object
   (setq item (vla-item newsset ctr))

   (setq int (vla-IntersectWith obj1 item acExtendNone))

   (setq int1
   (append
     int1
     (vlax-safearray->list (vlax-variant-value int))
   )
   )


				;increment the counter
   (setq ctr (1+ ctr))

 )					;repeat

				;delete the selection set
 (vla-delete (vla-item ssets "SS1"))

 (setq int1 (cdr int1))

 (setq	int2 '(nil)
i    0
 )
 (if (not (equal entname (entlast)))
   (command "_draworder" entname "" "d" (entlast))
 )
 (setq derent (entlast))
 (if (equal (assoc 0 (entget entname)) '(0 . "CIRCLE"))
   (progn
     (setq os (getvar "osmode"))
     (setvar "osmode" 512)
     (setq
pt1 (list (nth i int1) (nth (1+ i) int1) (nth (+ 2 i) int1))
     )
     (setq i (+ 3 i))
     (setq
pt2 (list (nth i int1) (nth (1+ i) int1) (nth (+ 2 i) int1))
     )
     (setq
pt3 (cdr (assoc 10 (entget entname)))
     )
     (command "_break" pt1 pt2)
     (command "arc" pt1 "f" pt2 pt3)
     (setq i (+ 3 i))
     (setvar "osmode" os)
   )
 )
 (while (< i (length int1))
   (setq
     ptint (list (nth i int1) (nth (1+ i) int1) (nth (+ 2 i) int1))
   )
   (command "_BREAK" ptint ptint)
   (setq i (+ 3 i))
 )
 (setq derent (entnext derent))
 (setq entfinal (entlast))
 (setq listent '(nil))
 (while (not (equal derent entfinal))
   (setq listent (append listent (list derent)))
   (setq derent (entnext derent))
 )
 (setq listent (append listent (list entfinal)))
 (setq listent (cdr listent))
 (isgroup entname)
 (setq group groupdef)
 (if is
   (addgroup group)
 )
 (setvar "PICKSTYLE" selstyle)
 (princ)

)

[zebulon_]

à toutes fins utiles ...

 

 

;;; créer un groupe avec les adresses d'éléments contenus dans LST

;;;

(defun makegrp (LST DESC / EN)

(command "_.-group" "_create" "*" DESC)

(foreach EN LST (command EN))

(command "")

)

[Titifonky]

Bonjour

 

Comme je l'ai dit dans mon précédent message, la routine que j'ai rajouté permettant de rassembler les morceaux crées au cours de la division ne créer pas un nouveau groupe mais ajoute les morceaux au groupe d'origine. Si l'entité divisé n'appartient pas à un groupe aucun groupe ne seras créer.

 

Mais dans tout les cas, tes quelques lignes de codes sont très interessantes. J'avais pour habitude de faire une boucle dans les cas ou j'avais besoin de repeter une commande du style "copy" avec cette solution je vais pouvoir alleger et simplifier le code de mes programmes.

 

Merci :D