Aller au contenu
Problème de lien d'inscription (résolu ?) ×

reconstruire lignes polylignes coupées

sergeluc

Par sergeluc
dans Pour aller plus loin en LISP

 Partager

Messages recommandés

sergeluc Newbie

sergeluc

Posté(e)
Posté(e)

bonjour ,

Je cherche à reconstruire des entités coupées de meme type "lignes polylignes ou arcs" depuis une sélection par fenetre.Les anciennes entités (coplanaires) sont supprimées et remplacées par une nouvelle .

 

Merci d'avance pour toute aide

 

Je joins pour exemple cette routine qui fonctionne mais par sélection de deux entités .

Ce lisp n'est pas de moi.

(defun c:REC-exct ( / ENTS1 ENTG1 EL ENTS2 ENTG2)
 (setq CL (getvar "CLAYER"))
 (setvar "CMDECHO" 0)
 (setq ENTS1 (car (entsel "\nPremiere entite")))
 (setq ENTG1 (entget ENTS1))
 (setq EL (cdr (assoc 8 ENTG1)))
 (setq ENTS2 (car (entsel "\nDeuxieme entite")))
 (setq ENTG2 (entget ENTS2))

(cond

 ((and (= (cdr (assoc 0 ENTG1)) "LINE")
   (= (cdr (assoc 0 ENTG2)) "LINE")
     ) ;_ Fin de and
   (progn
     (setq P1 (cdr (assoc 10 ENTG1))
    P2 (cdr (assoc 11 ENTG1))
    P3 (cdr (assoc 10 ENTG2))
    P4 (cdr (assoc 11 ENTG2))
     ) ;_ Fin de setq
     (command "_LAYER" "_S" EL "")
     (entdel ENTS1)
     (entdel ENTS2)
     (if (> (distance P1 P3) (distance P1 P4))
(setq P5 P1
      P6 P3
) ;_ Fin de setq
(setq P5 P1
      P6 P4
) ;_ Fin de setq
     ) ;_ Fin de if
     (if (> (distance P2 P3) (distance P2 P4))
(setq P7 P2
      P8 P3
) ;_ Fin de setq
(setq P7 P2
      P8 P4
) ;_ Fin de setq
     ) ;_ Fin de if
     (if (> (distance P5 P6) (distance P7 P8))
(command "_LINE" P5 P6 "")
(command "_LINE" P7 P8 "")
     ) ;_ Fin de if
     (command "_LAYER" "_S" CL "")
     (setvar "CMDECHO" 1)
   ) ;_ Fin de progn
 ) ;_ Fin de 1er cond

 ((and 
          (= (cdr (assoc 0 ENTG1)) "POLYLINE")
   (= (cdr (assoc 0 ENTG2)) "POLYLINE")
     ) ;_ Fin de and
   (progn
     (setq PW (cdr (assoc 40 ENTG1)))
     (command "_EXPLODE" ENTS1)
     (setq ENTS1 (entlast))
     (command "_EXPLODE" ENTS2)
     (setq ENTS2 (entlast))
     (setq ENTG1 (entget ENTS1))
     (setq ENTG2 (entget ENTS2))
     (setq P1 (cdr (assoc 10 ENTG1))
    P2 (cdr (assoc 11 ENTG1))
    P3 (cdr (assoc 10 ENTG2))
    P4 (cdr (assoc 11 ENTG2))
    EL (cdr (assoc 8 ENTG1))
     ) ;_ Fin de setq
     (entdel ENTS1)
     (entdel ENTS2)
     (command "_LAYER" "_S" EL "")
     (if (> (distance P1 P3) (distance P1 P4))
(setq P5 P1
      P6 P3
) ;_ Fin de setq
(setq P5 P1
      P6 P4
) ;_ Fin de setq
     ) ;_ Fin de if
     (if (> (distance P2 P3) (distance P2 P4))
(setq P7 P2
      P8 P3
) ;_ Fin de setq
(setq P7 P2
      P8 P4
) ;_ Fin de setq
     ) ;_ Fin de if
     (if (> (distance P5 P6) (distance P7 P8))
(command "_PLINE" P5 "_W" PW "" P6 "")
(command "_PLINE" P7 "_W" PW "" P8 "")
     ) ;_ Fin de if
     (command "_LAYER" "_S" CL "")
     (setvar "CMDECHO" 1)
   ) ;_ Fin de progn
 ) ;_ Fin de 2eme cond

 ((and 
          (= (cdr (assoc 0 ENTG1)) "LWPOLYLINE")
   (= (cdr (assoc 0 ENTG2)) "LWPOLYLINE")
     ) ;_ Fin de and
   (progn
     (setq PW (cdr (assoc 40 ENTG1)))
     (command "_EXPLODE" ENTS1)
     (setq ENTS1 (entlast))
     (command "_EXPLODE" ENTS2)
     (setq ENTS2 (entlast))
     (setq ENTG1 (entget ENTS1))
     (setq ENTG2 (entget ENTS2))
     (setq P1 (cdr (assoc 10 ENTG1))
    P2 (cdr (assoc 11 ENTG1))
    P3 (cdr (assoc 10 ENTG2))
    P4 (cdr (assoc 11 ENTG2))
    EL (cdr (assoc 8 ENTG1))
     ) ;_ Fin de setq
     (entdel ENTS1)
     (entdel ENTS2)
     (command "_LAYER" "_S" EL "")
     (if (> (distance P1 P3) (distance P1 P4))
(setq P5 P1
      P6 P3
) ;_ Fin de setq
(setq P5 P1
      P6 P4
) ;_ Fin de setq
     ) ;_ Fin de if
     (if (> (distance P2 P3) (distance P2 P4))
(setq P7 P2
      P8 P3
) ;_ Fin de setq
(setq P7 P2
      P8 P4
) ;_ Fin de setq
     ) ;_ Fin de if
     (if (> (distance P5 P6) (distance P7 P8))
(command "_PLINE" P5 "_W" PW "" P6 "")
(command "_PLINE" P7 "_W" PW "" P8 "")
     ) ;_ Fin de if
     (command "_LAYER" "_S" CL "")
     (setvar "CMDECHO" 1)
   ) ;_ Fin de progn
 ) ;_ Fin de 3eme cond



 ((and (= (cdr (assoc 0 ENTG1)) "ARC")
   (= (cdr (assoc 0 ENTG2)) "ARC")
     ) ;_ Fin de and
   (progn
     (setq
CA (strcase (getstring "\nChanger arcs en cercle? Y or <N> "))
     ) ;_ Fin de setq
     (if (= CA "Y")
(progn
  (setq	P1 (cdr (assoc 10 ENTG1))
	RA (cdr (assoc 40 ENTG1))
  ) ;_ Fin de setq
  (command "_LAYER" "_S" EL "")
  (entdel ENTS1)
  (entdel ENTS2)
  (command "_CIRCLE" P1 RA)
  (command "_LAYER" "_S" CL "")
) ;_ Fin de progn
(progn
  (setq	150X (car (polar (cdr (assoc 10 ENTG1))
			 (cdr (assoc 50 ENTG1))
			 (cdr (assoc 40 ENTG1))
		  ) ;_ Fin de polar
	     ) ;_ Fin de car
	150Y (cadr (polar (cdr (assoc 10 ENTG1))
			  (cdr (assoc 50 ENTG1))
			  (cdr (assoc 40 ENTG1))
		   ) ;_ Fin de polar
	     ) ;_ Fin de cadr
	151X (car (polar (cdr (assoc 10 ENTG1))
			 (cdr (assoc 51 ENTG1))
			 (cdr (assoc 40 ENTG1))
		  ) ;_ Fin de polar
	     ) ;_ Fin de car
	151Y (cadr (polar (cdr (assoc 10 ENTG1))
			  (cdr (assoc 51 ENTG1))
			  (cdr (assoc 40 ENTG1))
		   ) ;_ Fin de polar
	     ) ;_ Fin de cadr
	250X (car (polar (cdr (assoc 10 ENTG2))
			 (cdr (assoc 50 ENTG2))
			 (cdr (assoc 40 ENTG2))
		  ) ;_ Fin de polar
	     ) ;_ Fin de car
	250Y (cadr (polar (cdr (assoc 10 ENTG2))
			  (cdr (assoc 50 ENTG2))
			  (cdr (assoc 40 ENTG2))
		   ) ;_ Fin de polar
	     ) ;_ Fin de cadr
	251X (car (polar (cdr (assoc 10 ENTG2))
			 (cdr (assoc 51 ENTG2))
			 (cdr (assoc 40 ENTG2))
		  ) ;_ Fin de polar
	     ) ;_ Fin de car
	251Y (cadr (polar (cdr (assoc 10 ENTG2))
			  (cdr (assoc 51 ENTG2))
			  (cdr (assoc 40 ENTG2))
		   ) ;_ Fin de polar
	     ) ;_ Fin de cadr
	AP1  (list 150X 150Y)
	AP2  (list 151X 151Y)
	AP3  (list 251X 251Y)
  ) ;_ Fin de setq
  (command "_LAYER" "_S" EL "")
  (entdel ENTS1)
  (entdel ENTS2)
  (command "_ARC" AP1 AP2 AP3)
  (command "_LAYER" "_S" CL "")
) ;_ Fin de progn
     ) ;_ Fin de if
   ) ;_ Fin de progn
 ) ;_ Fin de 3eme cond

);cond generales

) ;_ Fin de defun

je joins aussi une routine plus significative ,laquelle ne fonctionne que pour des lignes mais c'est exactement

ce que je veux reproduire par sélection.

 

;sert a reconstruire des lignes coupées ,selection fenetre 
;==============================================================================
;	PROJ	Projection du point A sur la droite B C avec verification
;		selon D comme la fonction INTERS
;==============================================================================

(defun _proj (a b c d)
 (inters b
  c
  a
	(polar a (+ (* 0.5 pi) (angle  b c)) 1.0)
  d
  ) 
 ) 


(defun c:reb-lig ( / p q lot la i lb ea eb d p1 p2 p3 p4 d1 d2 ea10 ea11 eb10 eb11 temp)
(setq p nil q nil)
 (initget 1)
 (setq p (getpoint "\nPremier coin : "))
 (initget 1)
 (setq q (getcorner p "\nAutre coin : "))
(setvar "cmdecho" 0)
 (command "_erase" "_w" p q "")
 (if (setq lot (ssget "c" p q))
   (progn
     (while (setq la (ssname lot 0))
(ssdel la lot)
(setq i 0)
(repeat	(sslength lot)
  (setq lb (ssname lot i))

  (setq ea (entget la))
  (setq eb (entget lb))
  (setq	d
	 (apply	'(lambda (e1 e2)
		   (if (= "LINE" (cdr (assoc 0 e1)) (cdr (assoc 0 e2)))
		     (progn
		       (setq p1	(cdr (assoc 10 e1))
			     p2	(cdr (assoc 11 e1))
			     p3	(cdr (assoc 10 e2))
			     p4	(cdr (assoc 11 e2))
			     d1	(distance p1 (_proj p1 p3 p4 nil))
			     d2	(distance p2 (_proj p2 p3 p4 nil))
			     )
		       (if (> 0.001 (abs (- d1 d2)))
			 d1
			 nil
			 ) 
		       ) 
		     ) 
		   )
		(list ea eb)
		) 
	) 

  (cond	((not d) nil)
	((> 0.001 (abs d))
	 (if (= (cdr (assoc 8 ea)) (cdr (assoc 8 eb)))
	   (progn
	     (setq ea10	(cdr (assoc 10 ea))
		   ea11	(cdr (assoc 11 ea))
		   eb10	(cdr (assoc 10 eb))
		   eb11	(cdr (assoc 11 eb))
		   ) 
	     (if (> (distance ea10 eb10)
		    (distance ea10 eb11)
		    ) 
	       (setq temp eb10
		     eb10 eb11
		     eb11 temp
		     ) 
	       ) 
	     (if (< (distance ea10 eb10)
		    (distance ea11 eb10)
		    ) 
	       (setq temp ea10
		     ea10 ea11
		     ea11 temp
		     ) 
	       ) 
	     (entdel lb)
	     (entmod (append ea
			     (list (cons 10 ea10)
				   (cons 11 eb11)
				   ) 
			     ) 
		     ) 
	     T
	     ) 
	   ) 
	 )
	(T nil)
	) 

  (setq i (1+ i))
  ) 

) 
     ) 
   ) 
 (setvar "highlight" 1)
 (redraw)
 (princ)
 )

sergeluc Newbie

sergeluc

Posté(e)
  • Auteur
Posté(e)

Bonjour,

 

Tu utilises quelle version d'AutoCAD ?

Si c'est la 2012, la commande Joindre devrait faire l'affaire.

 

Bonjour bryce,

j'utilise la 2011 et je n'ai pas trouvé de lisp équivalant sur le net,c'est pourquoi je voulais faire évoluer ces routines .j'ai bien essayé mais sans résultant convaincant ,pour l'instant.La sélection multiple par fenetre

des LWPOLYLINES me pose des problèmes .

 

merci pour ta réponse

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
 Partager
Aller sur la liste des sujets
×
×
  • 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é