Classement

Pour info il y a une discussion similaire sur le forum Autodesk et l'utilisateur à soulevé un problème, que je pense avoir résolu. Je l'adapte à ma proposition faite ici, essaye cette version... (defun c:test ( / ss dfzz count n progress i ent dxf_ent pt_ins ss_pl tmp j ent_pl pt prm a_ref deriv alpha n_ent dxf_next) (setq ss (ssget '((0 . "INSERT") (2 . "TCPOINT")))) (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)) alpha (if (and (> (- alpha a_ref) (* 0.5 pi)) (<= (- alpha a_ref) (* pi 1.5))) (+ pi alpha) alpha ) n_ent ent ) (while (/= (cdr (assoc 0 (setq dxf_next (entget (entnext n_ent))))) "SEQEND") (if (eq (cdr (assoc 2 dxf_next)) "ALT") (progn (entmod (subst (cons 50 alpha) (assoc 50 dxf_next) dxf_next ) ) (setq count (1+ count)) ) ) (setq n_ent (cdar dxf_next)) ) ) ) ) (acet-ui-progress) ) ) (princ (strcat "\n" (itoa count) " Blocs TCPOINT ont leur attribut ALT pivoté sur " (itoa (sslength ss)) " sélectionnés.")) (prin1) )

Salut Glead. A la fin de ton premier (princ), il faut supprimer la parenthèse fermante à la ligne suivante (ligne 19)... Personnellement, j'utiliserais ça : defun c:Hach500 () (command "-hachures" "p" "SOLID" 1.0 0 "") ;Type de hachure pour le calque qui suit (mafonc "01211") (command "-hachures" "p" "SOLID" 1.0 0 "") (mafonc "01232") (command "-hachures" "p" "SOLID" 1.0 0 "") (mafonc "01321") (command "-hachures" "p" "SOLID" 1.0 0 "") (mafonc "01251") (command "-hachures" "p" "SOLID" 1.0 0 "") (mafonc "01252") ) ;_ Fin de defun (defun mafonc (calq /) (setvar "CLAYER" calq) (setq sel (ssget "X" (list (cons 0 "LWPOLYLINE") (cons 8 calq) (cons 70 1)))) (setq cont 0) (repeat (sslength sel) (setq entite (ssname sel cont)) (if (not (tblsearch "layer" (strcat Calq "_Hach"))) (command "-calque" "n" (strcat Calq "_Hach") "") (setvar "clayer" (strcat Calq "_Hach")) ) ;_ Fin de if (command "-hachures" "S" entite "" "") (setq cont (1+ cont)) ) ;_ Fin de repeat ) ;_ Fin de defun