Routine pour accrocher les fils

lecrabe · le 10 octobre 2006

Bonjour

SVP, j'ai "encore" besoin des Pros du DEV !

Voici mon problème : dessins de reseau (genre chevelu) avec des fils qui bien sur n'ont pas été dessinés avec un accrochage sur le point / bloc / cercle qui fait office de noeud (Tampon, Regard, Connection, Transfo, Boite de branchement, etc)

Donc j'aurais besoin d'une routine qui suite à une sélection de N objets graphiques:

- Demande un paramètre D (distance d'accrochage / rassemblement du chevelu)

- Cherche un Point ou bloc ou cercle (centre en fait) et rassemble TOUS les fils dans un rayon D donné juste avant

Puis boucle pour traiter le Point ou bloc ou cercle (centre en fait) suivant ...

Tant pis si du chevelu passe d'un noeud à un autre lors du traitement

(parce que les noeuds sont trop proches),

on supposera que justement les noeuds sont espacés d'une distance > 2 x D

Voilu, Voila

Le Decapode " vous remerciant par avance"

fabcad · le 10 octobre 2006

Ah merci lecrabe, j'en ai aussi besoin pour relier mes blocs poteaux d'incendie sur le reseau d'eau potable par une ligne ou polyligne avec une angle de 90°.

Cà me rendrait un grand service pour créer une topologie de type réseau sous MAP 3D.

http://www.imageshost.online.fr/up/1160745899_raccord_hydrant_reseau.JPG

Merci aux lispeurs.

[Edité le 13/10/2006 par fabcad]

(gile) · le 10 octobre 2006

Salut lecrabe,

Pourrais-tu préciser, le type d'entité des fils, pour simplifier le code ?

lecrabe · le 10 octobre 2006

Hello (gile)

Les fils seront bien entendu de simples lignes OU BIEN des polylignes simples "mono ou multi segments" (tronçons de canalisation, fil électrique, fibre optique, etc ...)

ReMerci, Le Decapode

(gile) · le 10 octobre 2006

Voilà, je pense que ça répond à ta demande, ça fonctionne avec des lignes, des polylignes optimisées et aussi avec des splines (je n'avais pas vu ta réponse).

Nouvelle version (11/10/06)

;;; AC_OB Accroche l'extémité des objets (ligne, polyligne spline) située
;;; en deçà d'une distances spécifiée au centre, point d'insertion, ou point
;;; du cercle bloc point sélectionné.

(defun c:ac_ob (/ dist ent elst ucszdir elev cen circle ss nlst pt_lst)
 (initget 7)
 (setq dist (getdist "\nSpécifiez le rayon du cercle d'acrrochage: "))
 (while (setq ent (car (entsel)))
   (setq elst (entget ent))
   (if	(member (cdr (assoc 0 elst)) '("CIRCLE" "POINT" "INSERT"))
     (progn
(setq ucszdir (trans '(0 0 1) 1 0 T)
      elev    (caddr (trans (getvar "ucsorg") 0 ucszdir))
)
(if (= (cdr (assoc 0 elst)) "POINT")
  (setq cen (trans (cdr (assoc 10 elst)) 0 ucszdir))
  (setq cen (trans (cdr (assoc 10 elst)) ent ucszdir))
)
(if (equal (caddr cen) elev 1e-9)
  (progn
    (entmake (list '(0 . "CIRCLE")
		   (cons 10 cen)
		   (cons 40 dist)
		   (cons 210 ucszdir)
	     )
    )
    (setq circle (entlast))
    (setq
      ss (SelByObj circle "CP" '((0 . "LINE,LWPOLYLINE")))
    )
    (if	ss
      (foreach n
	       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(setq nlst (entget n))
	(cond
	  ((and
	     (= (cdr (assoc 0 nlst)) "LINE")
	     (equal
	       (caddr (trans (cdr (assoc 10 nlst)) 0 ucszdir))
	       elev
	       1e-9
	     )
	     (equal
	       (caddr (trans (cdr (assoc 11 nlst)) 0 ucszdir))
	       elev
	       1e-9
	     )
	   )
	   (if
	     (			   cen
		   (trans (cdr (assoc 10 nlst)) 0 ucszdir)
		 )
		 dist
	     )
	      (entmod (subst (cons 10 (trans cen ucszdir 0))
			     (assoc 10 nlst)
			     (entget n)
		      )
	      )
	   )
	   (if (			     cen
		     (trans (cdr (assoc 11 nlst)) 0 ucszdir)
		   )
		   dist
	       )
	     (entmod (subst (cons 11 (trans cen ucszdir 0))
			    (assoc 11 nlst)
			    (entget n)
		     )
	     )
	   )
	  )
	  ((and	(= (cdr (assoc 0 (entget n))) "LWPOLYLINE")
		(equal (cdr (assoc 210 nlst)) ucszdir 1e-9)
		(equal (cdr (assoc 38 nlst)) elev 1e-9)
	   )
	   (setq pt_lst	(mapcar	'cdr
				(vl-remove-if-not
				  '(lambda (x) (= (car x) 10))
				  nlst
				)
			)
	   )
	   (if (		     (entmod (subst (cons 10 (list (car cen) (cadr cen)))
			    (assoc 10 nlst)
			    nlst
		     )
	     )
	   )
	   (if (		     (entmod (subst (cons 10 (list (car cen) (cadr cen)))
			    (assoc 10 (reverse nlst))
			    nlst
		     )
	     )
	   )
	  )
	)
      )
    )
    (entdel circle)
  )
  (alert
    "\nL'objet sélectionné n'est pas\ndans le plan XY du SCU."
  )
)
     )
     (alert
"\nL'objet sélectionné n'est pas\nun point, un cecle ou un bloc."
     )
   )
 )
 (princ)
)

;;; SelByObj -Gilles Chanteau- 06/10/06
;;; Crée un jeu de sélection avec tous les objets contenus ou 
;;; capturés, dans la vue courante, par l'objet sélectionné
;;; (cercle, ellipse, polyligne fermée).
;;; Arguments :
;;; - un nom d'entité (ename) 
;;; - un mode de sélection (Cp ou Wp)
;;; - un filtre de sélection ou nil

(defun SelByObj	(ent opt fltr / dist n lst prec dist p_lst)
 (vl-load-com)
 (if (= (type ent) 'ENAME)
   (setq ent (vlax-ename->vla-object ent))
 )
 (cond
   ((member (vla-get-ObjectName ent)
     '("AcDbCircle" "AcDbEllipse")
    )
    (setq dist	(/ (vlax-curve-getDistAtParam
	     ent
	     (vlax-curve-getEndParam ent)
	   )
	   50
	)
   n	0
    )
    (repeat 50
      (setq
 lst
  (cons
    (trans
      (vlax-curve-getPointAtDist ent (* dist (setq n (1+ n))))
      0
      1
    )
    lst
  )
      )
    )
   )
   (T
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (or (= (car x) 10)
		  (= (car x) 42)
	      )
	    )
	   (entget ent)
	 )
    )
    (while p_lst
      (setq
 lst
  (append
    lst
    (list (trans (append (cdr (assoc 10 p_lst))
			 (list (cdr (assoc 38 (entget ent))))
		 )
		 ent
		 1
	  )
    )
  )
      )
      (if (/= 0 (cdadr p_lst))
 (progn
   (setq prec (1+ (fix (* 50 (abs (cdadr p_lst)))))
	 dist (/ (- (if	(cdaddr p_lst)
		      (vlax-curve-getDistAtPoint
			ent
			(trans (cdaddr p_lst) ent 0)
		      )
		      (vlax-curve-getDistAtParam
			ent
			(vlax-curve-getEndParam ent)
		      )
		    )
		    (vlax-curve-getDistAtPoint
		      ent
		      (trans (cdar p_lst) ent 0)
		    )
		 )
		 prec
	      )
	 n    0
   )
   (repeat (1- prec)
     (setq
       lst (append
	     lst
	     (list
	       (trans
		 (vlax-curve-getPointAtDist
		   ent
		   (+ (vlax-curve-getDistAtPoint
			ent
			(trans (cdar p_lst) ent 0)
		      )
		      (* dist (setq n (1+ n)))
		   )
		 )
		 0
		 1
	       )
	     )
	   )
     )
   )
 )
      )
      (setq p_lst (cddr p_lst))
    )
   )
 )
 (ssget (strcat "_" opt) lst fltr)
)

[Edité le 10/10/2006 par (gile)]

[Edité le 11/10/2006 par (gile)]

(gile) · le 10 octobre 2006

Il y avait une petite erreur sur le code DXF de l'extrémité de fin des lignes, toutes mes excuses à ceux qui avaient déjà copié le code.

Réparée le 10/10/06 à 22h50.

Patrick_35 · le 10 octobre 2006

Il manque les secondes ;)

@+

(gile) · le 10 octobre 2006

Il me semble que la demande de fabcad n'est pas tout à fait la même.

La routine ci-dessus déplace les extrémités des objets sélectionnés dans le rayon spécifié sur le point, point d'insertion ou centre, ce qui, si j'ai bien compris, répond à la première demande.

S'il s'agit de raccorder les entités sélectionnées au point, point d'insertion ou centre de l'objet avec une autre ligne, c'est plutôt cela :

Nouvelle version (11/10/06)

;;; RAC_OB Raccorde les objets (ligne, polyligne spline) située
;;; en deçà d'une distance spécifiée au centre, point d'insertion, ou point
;;; du cercle, bloc point sélectionné.

(defun c:rac_ob	(/ dist ent elst ucszdir elev cen circle ss nlst)
 (initget 7)
 (setq dist (getdist "\nSpécifiez le rayon du cercle d'accrochage: "))
 (while (setq ent (car (entsel)))
   (setq elst (entget ent))
   (if	(member (cdr (assoc 0 elst)) '("CIRCLE" "POINT" "INSERT"))
     (progn
(setq ucszdir (trans '(0 0 1) 1 0 T)
      elev    (caddr (trans (getvar "ucsorg") 0 ucszdir))
)
(if (= (cdr (assoc 0 elst)) "POINT")
  (setq cen (trans (cdr (assoc 10 elst)) 0 ucszdir))
  (setq cen (trans (cdr (assoc 10 elst)) ent ucszdir))
)
(if (equal (caddr cen) elev 1e-9)
  (progn
    (entmake (list '(0 . "CIRCLE")
		   (cons 10 cen)
		   (cons 40 dist)
		   (cons 210 ucszdir)
	     )
    )
    (setq circle (entlast))
    (setq
      ss (SelByObj circle
		   "CP"
		   '((0 . "LINE,LWPOLYLINE"))
	 )
    )
    (if	ss
      (foreach n
	       (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
	(setq nlst (entget n))
	(if
	  (or
	    (and
	      (= (cdr (assoc 0 nlst)) "LINE")
	      (equal
		(caddr (trans (cdr (assoc 10 nlst)) 0 ucszdir))
		elev
		1e-9
	      )
	      (equal
		(caddr (trans (cdr (assoc 11 nlst)) 0 ucszdir))
		elev
		1e-9
	      )
	    )
	    (and (= (cdr (assoc 0 (entget n))) "LWPOLYLINE")
		 (equal (cdr (assoc 210 nlst)) ucszdir 1e-9)
		 (equal (cdr (assoc 38 nlst)) elev 1e-9)
	    )
	  )
	   (entmake (list '(0 . "LINE")
			  (cons 10 (trans cen ucszdir 0))
			  (cons	11
				(vlax-curve-getClosestPointTo
				  (vlax-ename->vla-object n)
				  (trans cen ucszdir 0)
				)
			  )
		    )
	   )
	)
      )
    )
    (entdel circle)
  )
  (alert
    "\nL'objet sélectionné n'est pas\ndans le plan XY du SCU."
  )
)
     )
     (alert
"\nL'objet sélectionné n'est pas\nun point, un cercle ou un bloc."
     )
   )
 )
 (princ)
)


;;; SelByObj -Gilles Chanteau- 06/10/06
;;; Crée un jeu de sélection avec tous les objets contenus ou 
;;; capturés, dans la vue courante, par l'objet sélectionné
;;; (cercle, ellipse, polyligne fermée).
;;; Arguments :
;;; - un nom d'entité (ename) 
;;; - un mode de sélection (Cp ou Wp)
;;; - un filtre de sélection ou nil

(defun SelByObj	(ent opt fltr / dist n lst prec dist p_lst)
 (vl-load-com)
 (if (= (type ent) 'ENAME)
   (setq ent (vlax-ename->vla-object ent))
 )
 (cond
   ((member (vla-get-ObjectName ent)
     '("AcDbCircle" "AcDbEllipse")
    )
    (setq dist	(/ (vlax-curve-getDistAtParam
	     ent
	     (vlax-curve-getEndParam ent)
	   )
	   50
	)
   n	0
    )
    (repeat 50
      (setq
 lst
  (cons
    (trans
      (vlax-curve-getPointAtDist ent (* dist (setq n (1+ n))))
      0
      1
    )
    lst
  )
      )
    )
   )
   (T
    (setq p_lst (vl-remove-if-not
	   '(lambda (x)
	      (or (= (car x) 10)
		  (= (car x) 42)
	      )
	    )
	   (entget ent)
	 )
    )
    (while p_lst
      (setq
 lst
  (append
    lst
    (list (trans (append (cdr (assoc 10 p_lst))
			 (list (cdr (assoc 38 (entget ent))))
		 )
		 ent
		 1
	  )
    )
  )
      )
      (if (/= 0 (cdadr p_lst))
 (progn
   (setq prec (1+ (fix (* 50 (abs (cdadr p_lst)))))
	 dist (/ (- (if	(cdaddr p_lst)
		      (vlax-curve-getDistAtPoint
			ent
			(trans (cdaddr p_lst) ent 0)
		      )
		      (vlax-curve-getDistAtParam
			ent
			(vlax-curve-getEndParam ent)
		      )
		    )
		    (vlax-curve-getDistAtPoint
		      ent
		      (trans (cdar p_lst) ent 0)
		    )
		 )
		 prec
	      )
	 n    0
   )
   (repeat (1- prec)
     (setq
       lst (append
	     lst
	     (list
	       (trans
		 (vlax-curve-getPointAtDist
		   ent
		   (+ (vlax-curve-getDistAtPoint
			ent
			(trans (cdar p_lst) ent 0)
		      )
		      (* dist (setq n (1+ n)))
		   )
		 )
		 0
		 1
	       )
	     )
	   )
     )
   )
 )
      )
      (setq p_lst (cddr p_lst))
    )
   )
 )
 (ssget (strcat "_" opt) lst fltr)
)

[Edité le 11/10/2006 par (gile)]

lecrabe · le 11 octobre 2006

Hello (gile)

Tes 2 routines semblent "SUPER" et je vais les tester "en profondeur"

et bien sur je te tiens au courant ...

Encore merci, Le Decapode

(gile) · le 11 octobre 2006

En l'état, les deux routines devraient fonctionner en 2D (tous les objets dans le plan du SCU courant).

Pour un fonctionnement en 3D (quelque soit le SCU courant) il faut que je rajoute des tests, ce qui demande de jongler avec les système de coordonées : le SCU courant, le SCG et les SCO des objets 2D (cercle, bloc et polylignes).

J'essaye de voir ça dans la journée.

lecrabe · le 11 octobre 2006

Hello (gile)

SVP du calme, des routines qui fonctionnent en 2D sur des objets graphiques normaux,

cela me semble très bien ... :) :D :cool:

Je n'ai pas encore testé, mais petite question: que fait réellement la 2eme routine pour Fabcad ?

Si j'ai bien compris sa demande :

Il désire le dessin automatique d'une ligne qui viendrait se projeter en perpendiculaire (depuis donc: point d'insertion d'un bloc, point graphique, centre d'un cercle) vers une ligne ou polyligne qui serait dans un rayon D donné !?

As tu compris la même chose ?

Le Decapode

(gile) · le 11 octobre 2006

Salut lecrabe,

Oui, j'ai bien compris la même chose et la routine crée une ligne depuis le point d'insertion d'un bloc, le point graphique ou le centre d'un cercle jusqu'au point le plus proche des lignes/polylignes dans le rayon donné (soit la projection perpendiculaire sur la ligne/polyligne soit son extrémité).

fabcad · le 11 octobre 2006

C'est cela même mon cher watson.

merci pour la routine.

fabcad

(gile) · le 11 octobre 2006

J'ai amélioré les deux routines, elles fonctionnent désormais pour tous les objets (point,bloc,cercle et lignes,polylignes) contenus dans le plan XY du SCU courant quelque soit l'orientation 3D de ce SCU par rapport au SCG.

Je recommande donc d'utiliser ces dernières versions plutôt que les anciennes.

kallain · le 11 octobre 2006

Et Hop, un bouton de plus pour RAC_OB :D

Bravo et merci (gile), mais moi je voudrais une polyligne : C'est possible ?

(gile) · le 11 octobre 2006

Salut kallain,

pour avoir une polyligne à la place d'une ligne pour le raccordement, dans Rac_ob, remplace :

(entmake (list '(0 . "LINE")
		       (cons 10 (trans cen ucszdir 0))
		       (cons 11
			     (vlax-curve-getClosestPointTo
			       (vlax-ename->vla-object n)
			       (trans cen ucszdir 0)
			     )
		       )
		 )
	)

par :

(entmake (list '(0 . "LWPOLYLINE")
		       '(100 . "AcDbEntity")
		       '(100 . "AcDbPolyline")
		       '(90 . 2)
		       '(70 . 0)
		       (cons 38 elev)
		       (cons 210 ucszdir)
		       (cons 10 cen)
		       (cons 10
			     (trans
			       (vlax-curve-getClosestPointTo
				 (vlax-ename->vla-object n)
				 (trans cen ucszdir 0)
			       )
			       0
			       ucszdir
			     )
		       )
		 )
	)

kallain · le 11 octobre 2006

Parfait,

encore merci :D

Connexion

Routine pour accrocher les fils

Messages recommandés

lecrabe

fabcad

(gile)

lecrabe

(gile)

(gile)

Patrick_35

(gile)

lecrabe

(gile)

lecrabe

(gile)

fabcad

(gile)

kallain

(gile)

kallain

Créer un compte ou se connecter pour commenter

Créer un compte

Se connecter

Forums

Naviguer

Activité

Information importante