Le portail francophone de la géomatique

Dylan · Fri 21 October 2016 11:40

Bonjour à tous,

j'ai un plan avec une multitude de poteaux que je dois relier alors je voudrais savoir s'il y a un moyen de raccorder plusieurs blocs les uns aux autres avec une polyligne ... histoire de ne pas avoir à y passer la journée !

Merci d'avance

Patrice · Fri 21 October 2016 12:07

Hello

SVP par quel "MIRACLE" le programme doit savoir qu'il faut relier le poteau X au poteau Y et non pas au poteau Z !?

GeoBye, Pat

Dylan · Fri 21 October 2016 13:34

je ne sais pas trop, on peut peut-être faire en sorte qu'il prenne le poteau le plus proche a chaque fois ou lui dire le poteau x est le premier et le z le denier pour qu'il raccorde tous les poteaux intermédiaire ? même s'il y a de la vérification a faire ensuite. je ne suis pas suffisamment calé en programmation pour savoir si c'est réalisable ou pas

bruno v. · Tue 25 October 2016 16:09

Bonjour,

On peut essayer quelque chose, cela fonctionnera relativement bien si les blocs sont disposés de façon linaire (selon un cheminement), par contre si l'implantation est de style quadrillage, le résultat sera plutôt aléatoire.
Le programme demandera la distance maxi entre blocs (poteaux) à respecter...

Enfin je te laisse essayer, cela te conviendra peut être...

NB: Veiller à ce que tous les blocs à traiter soient visibles à l'écran, le code reste succinct

Code:

(defun c:join_blok ( / js_mdbl js_wsel ename dxf_cod pt_ins lst_pt_ins d_max corner_dl corner_ul js_bl lremov n e_remov lst_pt ent_sel lst_d index)
  (princ "\nSélectionnez le modèle de bloc qui sera le départ de la polyligne")
  (while
    (null
      (setq js_mdbl
        (ssget "_+.:E:S"
          (list
            '(0 . "INSERT")
            (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
            (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
          )
        )
      )
    )
  )
  (setq
    js_wsel (ssadd)
    ename (ssname js_mdbl 0)
    dxf_cod (entget ename)
    pt_ins (cdr (assoc 10 dxf_cod))
    lst_pt_ins (list pt_ins)
  )
  (ssadd ename js_wsel)
  (initget 1)
  (setq d_max (getdist pt_ins "\nDistance maxi de recherche: "))
  (while pt_ins
    (setq
      corner_dl (mapcar '(lambda (x) (- x d_max)) pt_ins)
      corner_ur (mapcar '(lambda (x) (+ x d_max)) pt_ins)
      corner_dl (list (car corner_dl) (cadr corner_dl))
      corner_ur (list (car corner_ur) (cadr corner_ur))
      js_bl
      (ssget "_C"
        corner_dl
        corner_ur
        (foreach m
          (foreach n dxf_cod
            (if (not (member (car n) '(0 67 410 8 6 62 2 41 42 43 70 71 44 45 210)))
              (setq lremov (cons (car n) lremov))
            )
          )
          (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
        )
      )
    )
    (repeat (setq n (sslength js_wsel))
      (if (setq e_remov (ssmemb (ssname js_wsel (setq n (1- n))) js_bl))
        (ssdel e_remov js_bl)
      )
    )
    (cond
      ((not (zerop (sslength js_bl)))
        (setq lst_pt nil)
        (repeat (setq n (sslength js_bl))
          (setq ent_sel (ssname js_bl (setq n (1- n))))
          (setq lst_pt (cons (cdr (assoc 10 (entget ent_sel))) lst_pt))
        )
        (setq lst_d (mapcar '(lambda (x) (distance x (list (car pt_ins) (cadr pt_ins)))) lst_pt))
        (setq index (- (length lst_d) (length (member (apply 'min (mapcar '(lambda (x) (min x d_max)) lst_d)) lst_d))))
        (setq pt_ins (nth index lst_pt))
        (if pt_ins (progn (setq lst_pt_ins (cons pt_ins lst_pt_ins)) (ssadd (ssname js_bl index) js_wsel)))
      )
      (T (setq pt_ins nil))
    )
  )
  (cond
    (lst_pt_ins
      (entmakex
        (vl-list*
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 (length lst_pt_ins))
          (mapcar '(lambda (p) (cons 10 p)) lst_pt_ins)
        )
      )
    )
  )
  (prin1)
)

Dernière modification par bruno v. (Tue 25 October 2016 16:12)

Patrice · Wed 26 October 2016 16:39

Hello Bruno

SVP serait il possible d'avoir une version qui utilise la selection AutoCAD CLASSIQUE
et donc qui pourrait aussi recuperer une Selection Precedente !?

Merci d'avance, GeoBye, Pat

bruno v. · Thu 27 October 2016 10:00

Salut Patrice,

Ouille! Je redoute toujours tes demandes de micro-améliorations

Bon j'ai tenté quelque chose, mais jongler avec les jeux de sélections... pas évident, il y a parfois des réactions étranges; J'ai du trouver une autre voie que l'utilisation de (ssget "_+.:E:S") comme au premier post.

Quitte à faire j'ai étendu aux entités "POINT" (ça mangeait pas de pain, le codage reste le même)

Code:

(defun c:join_block ( / lst_flt js e_sel js_wsel ename dxf_cod pt_ins lst_pt_ins d_max corner_dl corner_ul js_bl lremov n e_remov lst_pt ent_sel lst_d index)
  (setq lst_flt
    (list
      '(0 . "INSERT,POINT")
      (cons 67 (if (eq (getvar "CVPORT") 1) 1 0))
      (cons 410 (if (eq (getvar "CVPORT") 1) (getvar "CTAB") "Model"))
    )
  )
  (or
    (setq js (ssget "_I" lst_flt))
    (setq js (ssget "_P" lst_flt))
  )
  (cond
    (js
      (sssetfirst nil js)
      (initget "Existant Nouveau _Current New")
      (if (eq (getkword "\nTraiter jeu de sélection [Existant/Nouveau] <Existant>: ") "New")
        (progn
          (sssetfirst nil nil)
          (setq
            js (ssadd)
            js (ssget lst_flt)
          )
          (sssetfirst nil js)
        )
      )
    )
    (T (setq js (ssget lst_flt)) (sssetfirst nil js))
  )
  (while
    (or
      (null (setq e_sel (entsel "\nSélectionnez le modèle de bloc ou le point qui sera le départ de la polyligne")))
      (not (member (cdr (assoc 0 (entget (car e_sel)))) '("INSERT" "POINT")))
    )
  ) 
  (setq
    js_wsel (ssadd)
    ename (car e_sel)
    dxf_cod (entget ename)
    pt_ins (cdr (assoc 10 dxf_cod))
    lst_pt_ins (list pt_ins)
  )
  (ssadd ename js_wsel)
  (initget 1)
  (setq d_max (getdist pt_ins "\nDistance maxi de recherche: "))
  (sssetfirst nil nil)
  (while pt_ins
    (setq
      corner_dl (mapcar '(lambda (x) (- x d_max)) pt_ins)
      corner_ur (mapcar '(lambda (x) (+ x d_max)) pt_ins)
      corner_dl (list (car corner_dl) (cadr corner_dl))
      corner_ur (list (car corner_ur) (cadr corner_ur))
      js_bl
      (ssget "_C"
        corner_dl
        corner_ur
        (foreach m
          (foreach n dxf_cod
            (if (not (member (car n) '(0 67 410 8 6 62 2 41 42 43 70 71 44 45 210)))
              (setq lremov (cons (car n) lremov))
            )
          )
          (setq dxf_cod (vl-remove (assoc m dxf_cod) dxf_cod))
        )
      )
    )
    (repeat (setq n (sslength js_wsel))
      (if (setq e_remov (ssmemb (ssname js_wsel (setq n (1- n))) js_bl))
        (ssdel e_remov js_bl)
      )
    )
    (repeat (setq n (sslength js_bl))
      (if (not (ssmemb (setq e_remov (ssname js_bl (setq n (1- n)))) js))
        (ssdel e_remov js_bl)
      )
    )
    (cond
      ((not (zerop (sslength js_bl)))
        (setq lst_pt nil)
        (repeat (setq n (sslength js_bl))
          (setq
            ent_sel (ssname js_bl (setq n (1- n)))
            lst_pt (cons (cdr (assoc 10 (entget ent_sel))) lst_pt)
          )
        )
        (setq
          lst_d (mapcar '(lambda (x) (distance x (list (car pt_ins) (cadr pt_ins)))) lst_pt)
          index (- (length lst_d) (length (member (apply 'min (mapcar '(lambda (x) (min x d_max)) lst_d)) lst_d)))
          pt_ins (nth index lst_pt)
        )
        (if pt_ins (progn (setq lst_pt_ins (cons pt_ins lst_pt_ins)) (ssadd (ssname js_bl index) js_wsel)))
      )
      (T (setq pt_ins nil))
    )
  )
  (cond
    (lst_pt_ins
      (entmakex
        (vl-list*
          (cons 0 "LWPOLYLINE")
          (cons 100 "AcDbEntity")
          (cons 100 "AcDbPolyline")
          (cons 90 (length lst_pt_ins))
          (mapcar '(lambda (p) (cons 10 p)) lst_pt_ins)
        )
      )
    )
  )
  (prin1)
)

Dylan · Fri 28 October 2016 10:05

Merci bruno c'est exactement ce que je cherchais, ça va me changer la vie

Communauté	Ressources	L'emploi	Le marché	L'association	Fils RSS
Forum Blogs Wiki Planet Sites amis	Agenda Biblio Fiches AMO-CNIG Paris PCGIS Téléchargements	Offres d'emploi Banque de CV Formations Démarche Métiers	Geo-Entreprises Geo-Communiqué Appels d'offres	L'association Qui sommes-nous ? Nous aider Bienfaiteurs Partenaires Historique Statuts	Tout le site Job Géomatique Services GeoBlogs ...	Faire un don Mentions légales

Le portail francophone de la géomatique

Annonce

#1 Fri 21 October 2016 11:40

[ACAD] Raccorder plusieurs blocs ensemble

#2 Fri 21 October 2016 12:07

Re: [ACAD] Raccorder plusieurs blocs ensemble

#3 Fri 21 October 2016 13:34

Re: [ACAD] Raccorder plusieurs blocs ensemble

#4 Tue 25 October 2016 16:09

Re: [ACAD] Raccorder plusieurs blocs ensemble

Code:

#5 Wed 26 October 2016 16:39

Re: [ACAD] Raccorder plusieurs blocs ensemble

#6 Thu 27 October 2016 10:00

Re: [ACAD] Raccorder plusieurs blocs ensemble

Code:

#7 Fri 28 October 2016 10:05

Re: [ACAD] Raccorder plusieurs blocs ensemble

Pied de page des forums