lisp pour accrocher extremites à une grille

[FRAXA]

Bonjour à tous!

Je suis à la recherche d'un lisp qui déplace les extrémités d'une ligne aux points d'accrochage à la grille les plus proches.

Et si possible le même ou un autre lisp qui déplace un bloc ( en prenant comme point de référence le point d'insertion) au point d'accrochage à la grille le plus proche.

 

Merci d'avance.

[bonuscad]

Il y avait ce sujet

 

Mais voici le même code qui s'appuie sur la valeur de la variable SNAPUNIT,

Pour les blocs, j'ai l'impression que les attributs ne suivent pas, donc le code est à approfondir

 

 

(defun round_number (xr n / )
(* (fix (atof (rtos (* xr n) 2 0))) (/ 1.0 n))
)
(defun c:regular_draw ( / js n_count ent dxf_ent dxf_lst)
(setq js (ssget '((0 . "FACE3D,ARC,ATTDEF,ATTRIB,CIRCLE,ELLIPSE,INSERT,LINE,POLYLINE,LWPOLYLINE,*TEXT,POINT,SHAPE,SOLID,TRACE"))) n_count -1)
(cond
	(js
		(setvar "cmdecho" 0)
		(command "_.undo" "_group")
		(while (setq ent (ssname js (setq n_count (1+ n_count))))
			(setq dxf_ent (entget ent))
			(cond
				((eq (cdr (assoc 0 dxf_ent)) "LWPOLYLINE")
					(setq dxf_lst (cdr dxf_ent) dxf_ent (list (car dxf_ent)))
					(while (cdr dxf_lst)
						(if (eq 10 (caar dxf_lst))
							(setq dxf_ent (cons (cons 10 (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdar dxf_lst) (getvar "SNAPUNIT"))) dxf_ent))
							(setq dxf_ent (cons (car dxf_lst) dxf_ent))
						)
						(setq dxf_lst (cdr dxf_lst))
					)
					(setq dxf_ent (reverse dxf_ent))
				)
				((eq (cdr (assoc 0 dxf_ent)) "POLYLINE")
					(while (eq (cdr (assoc 0 (setq dxf_ent (entget (entnext (cdar dxf_ent)))))) "VERTEX")
						(setq dxf_ent (subst (cons 10 (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdr (assoc 10 dxf_ent)) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT")))))) (assoc 10 dxf_ent) dxf_ent))
						(entmod dxf_ent)
					)
				)
				(T
					(foreach n dxf_ent
						(if (member (car n) '(10 11 12 13 40))
							(if (listp (cdr n))
								(setq dxf_ent (subst (cons (car n) (mapcar '(lambda (x p) (round_number x (/ 1 p))) (cdr n) (append (getvar "SNAPUNIT") (list (car (getvar "SNAPUNIT")))))) (assoc (car n) dxf_ent) dxf_ent))
								(setq dxf_ent (subst (cons (car n) (round_number (cdr n) (/ 1 (car (getvar "SNAPUNIT"))))) (assoc (car n) dxf_ent) dxf_ent))
							)
						)
					)
				)
			)
			(entmod dxf_ent)
			(entupd ent)
		)
		(command "_.undo" "_end")
		(setvar "cmdecho" 1)
		(princ (strcat "\n" (itoa n_count) " objet(s) transformé(s)."))
	)
	(T (princ "\nAucun objet valide trouvé."))
)
(prin1)
)

[FRAXA]

Merci Bonuscad, c'est exactement ce que je voulais.

Pour les attributs, un petit coup de battman et c'est reparti

[blizard]

hello

 

J'utilise ce lisp pour déplacer les extrémités d'une ligne sur les points snap de la grille:

 

(defun c:snap (/ snap-pt ss n elst)

 

(defun snap-pt (pt)

(mapcar '(lambda (x1 x2)

(if (minusp x1)

(* x2 (fix (- (/ x1 x2) 0.5)))

(* x2 (fix (+ (/ x1 x2) 0.5)))

)

)

pt

(getvar "SNAPUNIT")

)

)

 

(prompt

"\nSélectionner les objets à accrocher à la grille ou < Tous >: "

)

(or (setq ss (ssget '((0 . "LINE,LWPOLYLINE"))))

(setq ss (ssget "_X" '((0 . "LINE,LWPOLYLINE"))))

)

(if ss

(repeat (setq n (sslength ss))

(setq elst (entget (ssname ss (setq n (1- n)))))

(cond

((= (cdr (assoc 0 elst)) "LINE")

(entmod

(subst (cons 10 (snap-pt (cdr (assoc 10 elst))))

(assoc 10 elst)

(subst (cons 11 (snap-pt (cdr (assoc 11 elst))))

(assoc 11 elst)

elst

)

)

)

)

((= (cdr (assoc 0 elst)) "LWPOLYLINE")

(entmod

(mapcar '(lambda (x)

(if (= (car x) 10)

(cons 10 (snap-pt (cdr x)))

x

)

)

elst

)

)

)

)

)

)

(princ)

)

 

Et ce serait merveilleux si outre les polylignes, ce lisp pouvait s'appliquer au blocs et aux cotes, si qqn à le courage, merci d'avance

[(gile)]

Comme j'vais commencé...

 

Vite fait, à peine testé

 

(defun c:snap (/ snap-pt ss n elst)

 (defun snap-pt (pt)
   (mapcar '(lambda (x1 x2)
       (if (minusp x1)
	 (* x2 (fix (- (/ x1 x2) 0.5)))
	 (* x2 (fix (+ (/ x1 x2) 0.5)))
       )
     )
    pt
    (getvar "SNAPUNIT")
   )
 )

 (prompt
   "\nSélectionner les objets à accrocher à la grille ou : "
 )
 (or (setq ss (ssget '((0 . "LINE,LWPOLYLINE,INSERT,DIMENSION"))))
     (setq ss (ssget "_X" '((0 . "LINE,LWPOLYLINE,INSERT,DIMENSION"))))
 )
 (if ss
   (repeat (setq n (sslength ss))
     (setq elst (entget (ssname ss (setq n (1- n)))))
     (cond
((= (cdr (assoc 0 elst)) "LINE")
 (entmod
   (subst (cons 10 (snap-pt (cdr (assoc 10 elst))))
	  (assoc 10 elst)
	  (subst (cons 11 (snap-pt (cdr (assoc 11 elst))))
		 (assoc 11 elst)
		 elst
	  )
   )
 )
)
((= (cdr (assoc 0 elst)) "LWPOLYLINE")
 (entmod
   (mapcar '(lambda (x)
	      (if (= (car x) 10)
		(cons 10 (snap-pt (cdr x)))
		x
	      )
	    )
	   elst
   )
 )
)
((= (cdr (assoc 0 elst)) "INSERT")
 (entmod (subst	(cons 10 (snap-pt (cdr (assoc 10 elst))))
		(assoc 10 elst)
		elst
	 )
 )
 (entupd (cdr (assoc -1 elst)))
)
((= (cdr (assoc 0 elst)) "DIMENSION")
 (entmod
   (mapcar '(lambda (x)
	      (cond
		((= (car x) 10) (cons 10 (snap-pt (cdr x))))
		((= (car x) 11) (cons 11 (snap-pt (cdr x))))
		((= (car x) 13) (cons 13 (snap-pt (cdr x))))
		((= (car x) 14) (cons 14 (snap-pt (cdr x))))
		(T x)
	      )
	    )
	   elst
   )
 )
)
     )
   )
 )
 (princ)
) 

[blizard]

ca marche nickel

merci mille fois

un temps fou de gagné