Aller au contenu

commande dérivé de EXTRIM


Messages recommandés

Posté(e)

Bonjour à tous,

 

Je travaille sur Autocad v2005, et, depuis plusieurs semaines et en vain, je rercherche une fonction proche de la commande EXTRIM, mais qui en plus me supprime tous les objets exclus de la zone définie et qui ne coupe pas l'objet sélectionné comme limite.

En fait, le but de la manipulation est de découper un plan de masse (en 126 planches), en l'occurence c'ext celui du site PSA Sochaux (taille du fichier env. 16 Mo).

J'ai essayé de regarder le langage LISP, mais je n'y comprends rien du tout.

Sachant que les commandes XDELIM et CLIPIT ne font que cacher un ensemble, cette fonction est prohibée, car les conventions de la société n'autorise pas la diffusion du plan de masse complet.

 

Si quelqu'un pourrait m'aider, ce n'est pas de refus.

 

Salutations.

Posté(e)

Un exemple ici d'applicatif, mais bon courage sur des plans à plusieurs Megs !

Bureau d'études dessin.

Spécialiste Escaliers

Développement - Formation

 

./__\.
(.°=°.)
Posté(e)

Merci pour le lien Tramber, je l'ai testé, mais cette commande ne réponds pas vraiment à mon besoin. Je me suis peut-être mal exprimé lors de mon post.

En fait ce que je recherche c'est une fonction qui éxécute la même opération que la commande EXTRIM, mais, qui en plus supprime les éléments graphiques qui ne sont pas en contact avec l'objet défini comme limites.

 

 

Posté(e)

Alors il faut continuer avec EXTRIM et lancer l'effacement de TOUT puis S pour retirer une Fenêtre ou une Capture.

 

Le problème avec EXTRIM, c'est qu'on ne peut pas facilement le rentrer dans un programme.

Bureau d'études dessin.

Spécialiste Escaliers

Développement - Formation

 

./__\.
(.°=°.)
Posté(e)

Tu peux essayer ceci, en espérant que cela fonctionne pour toi.

 

Necessite un programme de Kamal Boutora nommé "QBRICK".

Modifier le code suivant la version de Qbrick utilisé

Voir ICI

 

(defun def_bub_pl (ls lb flag_closed / ls lb rad a l_new)
(if (not (zerop flag_closed)) (setq ls (append ls (list (car ls)))))
(while (cadr ls)
	(if (zerop (car lb))
		(setq l_new (append l_new (list (car ls))))
		(progn
			(setq
				rad (/ (distance (car ls) (cadr ls)) (sin (* 2.0 (atan (abs (car lb))))) 2.0)
				a (- (/ pi 2.0) (- pi (* 2.0 (atan (abs (car lb))))))
			)
			(if (< a 0.0) (setq a (- (* 2.0 pi) a)))
			(if (or (and (< (car lb) 0.0) (> (car lb) -1.0)) (> (car lb) 1.0))
				(setq l_new (append l_new (reverse (cdr (reverse (buble_pts (polar (car ls) (- (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
				(setq l_new (append l_new (reverse (cdr (reverse (buble_pts (polar (car ls) (+ (angle (car ls) (cadr ls)) a) rad) (car ls) (cadr ls) rad (car lb)))))))
			)
		)
	)
	(setq ls (cdr ls) lb (cdr lb))
)
(append l_new (list (car ls)))
)
(defun buble_pts (pt_cen pt_begin pt_end rad sens / inc ang nm p1 p2 lst)
(setq
	inc (angle pt_cen (if (< sens 0.0) pt_end pt_begin))
	ang (+ (* 2.0 pi) (angle pt_cen (if (< sens 0.0) pt_begin pt_end)))
	nm (fix (/ (rem (- ang inc) (* 2.0 pi)) (/ (* pi 2.0) 72.0)))
)
(repeat nm
	(setq
		p1 (polar pt_cen inc rad)
		inc (+ inc (/ (* pi 2.0) 72.0))
		lst (append lst (list p1))
	)
)
(setq
	p2 (polar pt_cen ang rad)
	lst (append lst (list p2))
)
(if (< sens 0.0) (reverse lst) lst)
)
(defun make_fence ( / )
(cond
	((eq typent "LWPOLYLINE")
		(setq
			closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
			lst (mapcar '(lambda (x) (trans x (car ent) 1)) (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 10)) dxf_ent)))
			l_bub (mapcar 'cdr (vl-remove-if '(lambda (x) (/= (car x) 42)) dxf_ent))
			lst (def_bub_pl lst l_bub closed)
		)
	)
	((eq typent "POLYLINE")
		(setq
			closed (boole 1 (cdr (assoc 70 dxf_ent)) 1)
			e_next (entnext (car ent))
		)
		(while (= "VERTEX" (cdr (assoc 0 (setq dxf_next (entget e_next)))))
			(if (zerop (boole 1 223 (cdr (assoc 70 dxf_next))))
				(setq
					lst (cons (trans (cdr (assoc 10 dxf_next)) (car ent) 1) lst)
					l_bub (cons (cdr (assoc 42 dxf_next)) l_bub)
				)
			)
			(setq e_next (entnext e_next))
		)
		(setq
			lst (reverse lst)
			l_bub (reverse l_bub)
			lst (def_bub_pl lst l_bub closed)
		)
	)
	((eq typent "CIRCLE")
		(setq
			lst
				(buble_pts
					(trans (cdr (assoc 10 dxf_ent)) (car ent) 1)
					(polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) 0.0 (cdr (assoc 40 dxf_ent)))
					(polar (trans (cdr (assoc 10 dxf_ent)) (car ent) 1) (- (* 2.0 pi) (/ (* pi 2.0) 36.0)) (cdr (assoc 40 dxf_ent)))
					(cdr (assoc 40 dxf_ent))
					1
				)
			lst (append lst (list (car lst)))
			closed 1
		)
	)
	(T (princ "\nN'est pas un Cercle ou une Polyligne!"))
)
)
(defun c:evider ( / ent dxf_ent typent closed lst l_bub e_next osmd n pt_g e_fence ss l_ent js_all ssb key tmp)
(while (null (setq ent (entsel "\nChoix du contour d'évidement: "))))
(setq typent (cdr (assoc 0 (setq dxf_ent (entget (car ent))))))
(make_fence)
(cond
	((and lst (not (zerop closed)))
		(if (equal (last lst) (car lst)) (setq lst (cdr lst)))
		(setq osmd (getvar "osmode"))
		(setvar "osmode" 0)
		(setvar "cmdecho" 0)
		(command "_.undo" "_group")
		(command "'_.zoom" "_window"
			(list (eval (cons min (mapcar 'car lst))) (eval (cons min (mapcar 'cadr lst))))
			(list (eval (cons max (mapcar 'car lst))) (eval (cons max (mapcar 'cadr lst))))
		)
		(setq n (float (length lst)))
		(setq pt_g (list (/ (apply '+ (mapcar 'car lst)) n) (/ (apply '+ (mapcar 'cadr lst)) n)))
		(command "_.offset" "0.25" ent (polar (cadr ent) (angle (cadr ent) pt_g) (distance (cadr ent) pt_g)) "")
		(setq e_fence (entlast))
		(if (not (member "qbrick2000.arx" (arx))) (arxload "qbrick2000.arx"))
		(command "_.qbrick" "_fence")
		(foreach n lst (command n))
		(command (car lst) "" "")
		(setq typent (cdr (assoc 0 (setq dxf_ent (entget e_fence)))))
		(make_fence)
		(setq ss (ssget "_CP" lst))
		(setq
			l_ent (if ss (ssnamex ss))
			js_all (ssget "_X")
		)
		(foreach n l_ent (if (eq (type (cadr n)) 'ENAME) (setq ssb (ssdel (cadr n) js_all))))
		(if (zerop (getvar "pickfirst")) (setvar "pickfirst" 1))
		(if (and ss ssb (= 0 (getvar "CMDACTIVE"))) 
			(progn
				(princ "\n pour inverser la sélection; /[Espace]/Click+droit pour finir!.")
				(while (and (not (member (setq key (grread T 4 2)) '((2 13) (2 32)))) (/= (car key) 25))
					(sssetfirst nil ss)
					(cond
						((eq (car key) 3)
							(setq tmp ss ss ssb ssb tmp)
						)
					)
				)
			)
		)
		(command "_.erase" ss "")
		(command "_.zoom" "_previous")
		(command "_.undo" "_end")
		(setvar "cmdecho" 1)
		(setvar "osmode" osmd)
	)
)
(prin1)
)

Choisissez un travail que vous aimez et vous n'aurez pas à travailler un seul jour de votre vie. - Confucius

Créer un compte ou se connecter pour commenter

Vous devez être membre afin de pouvoir déposer un commentaire

Créer un compte

Créez un compte sur notre communauté. C’est facile !

Créer un nouveau compte

Se connecter

Vous avez déjà un compte ? Connectez-vous ici.

Connectez-vous maintenant
×
×
  • Créer...

Information importante

Nous avons placé des cookies sur votre appareil pour aider à améliorer ce site. Vous pouvez choisir d’ajuster vos paramètres de cookie, sinon nous supposerons que vous êtes d’accord pour continuer. Politique de confidentialité