@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)
)