Nous utilisons des cookies pour vous garantir la meilleure expérience sur notre site. Si vous continuez à utiliser ce dernier, nous considèrerons que vous acceptez l'utilisation des cookies. J'ai compris ! ou En savoir plus !.
banniere

Le portail francophone de la géomatique


Toujours pas inscrit ? Mot de passe oublié ?
Nom d'utilisateur    Mot de passe              Toujours pas inscrit ?   Mot de passe oublié ?

Annonce

Suite à un problème technique intervenu entre le 22 et le 23 mars, nous avons du procéder dans la soirée du 25 mars, à la restauration de la base de données du 24 mars (matinée).

En clair, nous avons perdu vos contributions et inscriptions du dimanche 24 et du lundi 25 mars.
Nous vous prions de nous excuser.

#1 Mon 28 October 2013 11:21

Dylan
Participant occasionnel
Date d'inscription: 14 Jan 2013
Messages: 19

Accrocher extrémité d'une polyligne au centre d'un bloc

Bonjour,

    J'utilise depuis quelques temps ce lisp qui me permet de raccrocher les extrémités des polylignes proche d'un bloc ( en précisant le rayon d'action ) au centre de celui-ci  : ( Un grand merci à Gile pour ce lisp )


Code:

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

(defun c:aco (/ 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
        (setq ang 0.0
          circle nil
        )
        (repeat 50
          (setq circle (cons (polar cen ang dist) circle)
            ang       (+ ang (/ pi 25))
          )
        )
        (setq
          ss (ssget "_CP" circle '((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
             (<= (distance
               cen
               (trans (cdr (assoc 10 nlst)) 0 ucszdir)
             )
             dist
             )
              (entmod (subst (cons 10 (trans cen ucszdir 0))
                     (assoc 10 nlst)
                     (entget n)
                  )
              )
           )
           (if (<= (distance
                 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 (<= (distance cen (car pt_lst)) dist)
             (entmod (subst (cons 10 (list (car cen) (cadr cen)))
                    (assoc 10 nlst)
                    nlst
                 )
             )
           )
           (if (<= (distance cen (last pt_lst)) dist)
             (entmod (subst (cons 10 (list (car cen) (cadr cen)))
                    (assoc 10 (reverse nlst))
                    nlst
                 )
             )
           )
          )
        )
          )
        )
      )
      (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)
)

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

(defun c:rac_ob    (/ dist ent elst ucszdir elev cen circle ss nlst)
  (vl-load-com)
  (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
        (setq ang 0.0
          circle nil
        )
        (repeat 50
          (setq circle (cons (polar cen ang dist) circle)
            ang       (+ ang (/ pi 25))
          )
        )
        (setq
          ss (ssget "_CP" circle '((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)
                    )
                  )
                )
           )
        )
          )
        )
      )
      (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)
)

Il fonctionne à merveille, mais j'aimerais modifier ce LISP de manière à pouvoir sélectionner plusieurs bloc en même temps avec la fonction de sélection pointeur d'autocad ( Le lisp actuellement fonctionne avec une sélection manuelle unique d'un bloc ) Je suis bloqué, quelqu'un aurait- une idée ?

merci à tous !

Hors ligne

 

Pied de page des forums

Powered by FluxBB