- Marquer comme nouveau
- Marquer
- S'abonner
- Sourdine
- S'abonner au fil RSS
- Lien permanent
- Imprimer
- Signaler
Bonjour,
Après quelques recherches, j'ai trouvé ce lisp qui permet effectivement de tourner les blocs selon une polyligne.
Mais j'ai deux soucis :
1. le bloc tourne mais l'attribut ne suit pas
2. j'aurais voulu sélectionner une seule fois tous les blocs et qu'ils s'orientent tous par rapport à la ligne la plus proche, après je suppose que ça doit être compliqué en terme de programmation.
Je joins un .dwg d'exemple pour effectuer d'éventuels tests.
Un tout grand merci d'avance.
(defun c:RotateToLine nil (c:AlignToLine) (princ))
(defun c:AlignToLine ( / ss pl i en ed pc pt pp an et)
(if (and (setq ss (ssget "_:L" '((0 . "*TEXT,INSERT"))))
(setq pl (car (entsel "\nSelect line to enclose to: ")))
(wcmatch (cdr (assoc 0 (entget pl))) "*LINE,ARC,CIRCLE,RAY")
(wcmatch (cdr (assoc 0 (entget pl))) "~MLINE")
)
(repeat (setq i (sslength ss))
(if (setq en (ssname ss (setq i (1- i)))
ed (entget en)
et (cdr (assoc 0 ed))
pc (if (and (= "TEXT" et)
(/= 0 (cdr (assoc 72 ed)) (cdr (assoc 73 ed))))
11
10)
pt (cdr (assoc pc ed))
pp (vlax-curve-getClosestPointTo pl pt)
an (angle '(0 0 0) (vlax-curve-getFirstDeriv pl (vlax-curve-getParamAtPoint pl pp))))
(entmod (append ed
(list ;(cons pc (polar pp (angle pp pt) 0))
(cons 50 (setq an (if (= et "MTEXT")
(- an (angle '(0 0 0) (getvar 'UCSXDIR)))
an)
an (if (< an 0)
(+ an (* 2 pi))
an)
an (if (and (<= (if (= et "MTEXT")
an
(angle (trans '(0 0 0) 0 1) (trans (polar '(0 0 0) an 1) 0 1))) ; readable text mtext ucs
(* 1.5 pi))
(> (if (= et "MTEXT")
an
(angle (trans '(0 0 0) 0 1) (trans (polar '(0 0 0) an 1) 0 1)))
(* 0.5 pi)))
(+ an pi)
an)))))))))
(princ)
)
Le titre du sujet a été modifié par un modérateur pour faciliter la recherche. Titre original:
Rotation blocs selon polyligne
Résolu ! Accéder à la solution.
Link copied