Annonces
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.

[AUTOCAD 2024 MAP 3D fr] Orientation automatique de blocs selon la polyligne la plus proche

SET040
Advocate

[AUTOCAD 2024 MAP 3D fr] Orientation automatique de blocs selon la polyligne la plus proche

SET040
Advocate
Advocate

Bonjour tout le monde,

Je cherche à orienter automatiquement tous les bocs de mon dessin suivant la polyligne la plus proche (le but étant, dans un relevé de voirie, d'orienter en une fois tous mes objet suivant les bordure/facades les plus proches).

 

J'ai trouvé le lisp ci-jpont sur une autre discussion d'Autodesk forum (https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/automatically-orientating-blocks-par...)


Mais quand je le lance chez moi (Autocad Map 3D fr) il ne fonctionne pas.
J'ai un message d'erreur dans ma ligne de commande :
Commande: abp
; erreur: no function definition: OU

Quelqu'un pourrait-il m'aider à déboguer cà, svp ?

D'avance un tout grand merci 🙂

0 J'aime
Répondre
Solutions acceptées (1)
396 Visites
8 Réponses
Replies (8)

-didier-
Advisor
Advisor

Bonjour @SET040 

 

En pièce jointe le LSP corrigé.

Il a dû passer par un traducteur.

 

Du coup, j'ai mis LeLong comme choix par défaut, valider à vide pour répondre à la question fait que LeLong est choisi.

 

Amicalement

 

Éternel débutant.. my site for learning : Programmer dans AutoCAD

DA

EESignature

0 J'aime

SET040
Advocate
Advocate

Bonjour Didier, 

Merci pour ta réponse, j'ai pu tester mais malheureusement ce n'est pas ce que je recherche du coup ^^

J'aurais voulu que mon bloc reste au même endroit mais prenne juste l'orientation de la polyligne proche (comme dans mon fichier .dwg d'exemple en piece jointe)

Et de préférence je cherche une commande qui applique cette même manip sur TOUS les blocs de mon dessin en une fois. Mais j'ai du mal à me dire si c'est évident à faire ou pas en lisp

J'ai environ 800-1000 blocs à orienter ainsi chaque jour... 😥

0 J'aime

CADaSchtroumpf
Advisor
Advisor

Bonjour,

Il y a eu une demande très similaire faite sur CadXp

Donc en la simplifiant pour toi, est que cela fera l'affaire?

Notes bien que la distance de recherche doit a peu près correspondre à la distance de ton insertion de bloc à la polyligne.

(defun c:test ( / ss dfzz count n progress i ent dxf_ent pt_ins ss_pl ent_pl pt prm a_ref deriv alpha)
  (setq ss (ssget '((0 . "INSERT"))))
  (cond
    (ss
      (if (not dfzz) (setvar "USERR1" 1E-02))
      (initget 4)
      (if (not (setq dfzz (getdist (strcat "\nRayon de recherche? <" (rtos (getvar "USERR1") 2 2) "> : "))))
        (setq dfzz (getvar "USERR1"))
        (setvar "USERR1" dfzz)
      )
      (setq
        count 0
        progress (setq n (sslength ss))
        i 0
      )
      (acet-ui-progress-init "Progression:" progress)
      (repeat n
        (setq
          ent (ssname ss (setq n (1- n)))
          dxf_ent (entget ent)
          pt_ins (cdr (assoc 10 dxf_ent))
          ss_pl (ssget "_C" (trans (mapcar '- pt_ins (list dfzz dfzz 0.0)) 0 1) (trans (mapcar '+ pt_ins (list dfzz dfzz 0.0)) 0 1) '((0 . "LWPOLYLINE")))
        )
        (acet-ui-progress-safe (setq i (1+ i)))
        (cond
          ((and ss_pl (eq (sslength ss_pl) 1))
            (setq
              ent_pl (ssname ss_pl 0)
              pt (vlax-curve-getClosestPointToProjection ent_pl pt_ins '(0 0 1) nil)
              prm (vlax-curve-getParamAtPoint ent_pl pt)
              a_ref (atan (/ (cadr (getvar "ucsxdir")) (car (getvar "ucsxdir"))))
              deriv (vlax-curve-getfirstderiv ent_pl prm)
              alpha (atan (cadr deriv) (car deriv))
              alpha (rem (+ (* 2 pi) alpha) (* 2 pi))
            )
            (entmod
              (subst
                (cons 50 alpha)
                (assoc 50 dxf_ent)
                dxf_ent
              )
            )
            (setq count (1+ count))
          )
        )
      )
      (acet-ui-progress)
    )
  )
  (princ (strcat "\n" (itoa count) " Blocs pivoté sur " (itoa (sslength ss)) " sélectionnés."))
  (prin1)
)
0 J'aime

-didier-
Advisor
Advisor

Bonjour @SET040 

 

Il suffit pour le rendre conforme à la demande de mettre un point virgule en entête de la ligne 32

Snag_23ac5b3d.png

 

 Amicalement

Éternel débutant.. my site for learning : Programmer dans AutoCAD

DA

EESignature

0 J'aime

manon_puel
Community Manager
Community Manager

Bonjour @SET040 

Merci d’avoir posé cette question sur nos forums ! La communauté a essayé de vous aider au mieux. Si des réponses vous paraissent appropriées, voulez vous avoir l'amabilité de cliquer sur le bouton  APPROUVER LA SOLUTION  en bas de la réponse qui apporte une solution?
Merci de ne pas accepter comme solution le message que vous êtes en train de lire.


Manon Puel animatrice de la communauté francophone
0 J'aime

SET040
Advocate
Advocate

Bonjour Cadashtroumpf,

C'est effectivement le lisp le plus abouti que j'ai vu jusqu'à présent pour mon cas.

Cependant, serait-il possible de supprimer le rayon de recherche ?

En effet, si 2 polylignes sont présentes dans le rayon de recherche (ex :  3m), le lisp ne fonctionne plus.

Il ne fonctionne que s'il rencontre une seule polyligne.

Puis, définir un rayon pour chacun de mes points ça sera très long 😅

Encore merci à toi,

PS : je joins un ficher TEST.dwg pour illustrer mon propos

0 J'aime

CADaSchtroumpf
Advisor
Advisor
Solution acceptée

@SET040  a écrit :

Bonjour Cadashtroumpf,

C'est effectivement le lisp le plus abouti que j'ai vu jusqu'à présent pour mon cas.

Cependant, serait-il possible de supprimer le rayon de recherche ?

En effet, si 2 polylignes sont présentes dans le rayon de recherche (ex :  3m), le lisp ne fonctionne plus.

Il ne fonctionne que s'il rencontre une seule polyligne.

Puis, définir un rayon pour chacun de mes points ça sera très long 😅

Encore merci à toi,

PS : je joins un ficher TEST.dwg pour illustrer mon propos


@SET040 

Bonjour,

Dans ton cas il ne m'est pas possible de supprimer cette distance de recherche car pour cela il faudrait que les insertions soient exactement sur une polyligne.

Cependant j'ai modifié le code; si plusieurs polylignes sont trouvées, il ne retiendra que la plus proche en distance.

(defun c:test ( / ss dfzz count n progress i ent dxf_ent pt_ins ss_pl tmp j ent_pl l_d pt prm a_ref deriv alpha)
  (setq ss (ssget '((0 . "INSERT"))))
  (cond
    (ss
      (if (zerop (getvar "USERR1")) (setvar "USERR1" 1E-02) (getvar "USERR1"))
      (initget 4)
      (if (not (setq dfzz (getdist (strcat "\nRayon de recherche? <" (rtos (getvar "USERR1") 2 2) "> : "))))
        (setq dfzz (getvar "USERR1"))
        (setvar "USERR1" dfzz)
      )
      (setq
        count 0
        progress (setq n (sslength ss))
        i 0
      )
      (acet-ui-progress-init "Progression:" progress)
      (repeat n
        (setq
          ent (ssname ss (setq n (1- n)))
          dxf_ent (entget ent)
          pt_ins (cdr (assoc 10 dxf_ent))
          ss_pl (ssget "_C" (trans (mapcar '- pt_ins (list dfzz dfzz 0.0)) 0 1) (trans (mapcar '+ pt_ins (list dfzz dfzz 0.0)) 0 1) '((0 . "LWPOLYLINE")))
        )
        (cond
          ((and ss_pl (> (sslength ss_pl) 1))
            (setq tmp (ssadd) l_d nil)
            (repeat (setq j (sslength ss_pl))
              (setq
                ent_pl (ssname ss_pl (setq j (1- j)))
                l_d
                (cons
                  (cons
                    (distance pt_ins (vlax-curve-getClosestPointToProjection ent_pl pt_ins '(0 0 1) nil))
                    ent_pl
                  )
                  l_d
                )
              )
            )
            (ssadd (cdr (assoc (apply 'min (mapcar 'car l_d)) l_d)) tmp)
            (setq ss_pl tmp)
          )
        )
        (acet-ui-progress-safe (setq i (1+ i)))
        (cond
          ((and ss_pl (eq (sslength ss_pl) 1))
            (setq
              ent_pl (ssname ss_pl 0)
              pt (vlax-curve-getClosestPointToProjection ent_pl pt_ins '(0 0 1) nil)
              prm (vlax-curve-getParamAtPoint ent_pl pt)
              a_ref (atan (/ (cadr (getvar "ucsxdir")) (car (getvar "ucsxdir"))))
              deriv (vlax-curve-getfirstderiv ent_pl prm)
              alpha (if deriv (atan (cadr deriv) (car deriv)) 0.0)
              alpha (rem (+ (* 2 pi) alpha) (* 2 pi))
            )
            (entmod
              (subst
                (cons 50 alpha)
                (assoc 50 dxf_ent)
                dxf_ent
              )
            )
            (setq count (1+ count))
          )
        )
      )
      (acet-ui-progress)
    )
  )
  (princ (strcat "\n" (itoa count) " Blocs pivoté sur " (itoa (sslength ss)) " sélectionnés."))
  (prin1)
)
0 J'aime

SET040
Advocate
Advocate

Merci infiniment @CADaSchtroumpf 

Tu me retires une énorme épine du pied !

Un tout grand merci 

0 J'aime