#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
