Topic: FIX LINES TO SNAP POINTS...

[ribarm]

As it's stated in title, I want to set SNAPUNIT system variable... Values can differ in X and Y directions...
Then routine will ask to select LINES and then they will be modified so that each end point coincide with SNAP points when SNAP is turned ON...
I haven't started anything as I don't know how to approach to this task, so your input would be appreciated with welcome...

M.R.

[ribarm]

I double posted this problem, so just to inform for you to check this topic too :
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/fix-lines-to-snap-points/td-p/9869210

[ribarm]

If the end point of 2D LINE is somewhere in between all 4 surrounding SNAP POINTS - here is the priority order (left->right;bottom->up)... So this order : lower left SNAP POINT, upper left SNAP POINT, lower right SNAP POINT, upper right SNAP POINT...

[Stefan]

If you are looking for the mathematical solution, it is very simple:

n - the coordinate to fix, d - precision (or snap distance)
The new coordinate: d*(round (n/d))

[ribarm]

That (round) function should work the way I described in post 3... I was thinking something like I have point and 4 points that surrounds it - then correct point to nearest surrounding point or if equals all 4 distances to lower left; if equals and smaller ll ul to pt (smaller than to lr ur), then correct it to ll; if equals and smaller ll lr, then correct it to ll; if equals and smaller ul ur, then correct it to ul; if equal and smaller lr ur, then correct it to lr...

[Stefan]

You can roll your own round function to work as you like. I'm using

Code - Auto/Visual Lisp: [Select]

1. (* d (atof (rtos (/ n d) 2 0)))

in a similar lisp.
This ensures that the destination point is on the nearest snap point. The only problem is when the initial point is exactly in the middle, but I'm ok with rounding 0.5 up to next integer.

I think you only have 2 possibilities as you are rounding each direction independently.
I think something like this will round the 0.5 fraction down to 0.

Code - Auto/Visual Lisp: [Select]

1. (* d (atof (rtos (- (/ n d) 1e-8) 2 0)))

[ribarm]

I've put something together, but untested and according to my opinions, so may be undesired for some of us...

Code - Auto/Visual Lisp: [Select]

1. (defun c:fix2dlines2snappts ( / u dx dy ss i li pl lix p11 p12 p13 p14 p1 p21 p22 p23 p24 p2 )
2.   (setq u (getvar 'snapunit))
3.   (setq dx (car u) dy (cadr u))
4.   (if (setq ss (ssget "_:L" (list '(0 . "LINE") '(-4 . "*,*,=") '(10 0.0 0.0 0.0) '(-4 . "*,*,=") '(11 0.0 0.0 0.0))))
5.     (repeat (setq i (sslength ss))
6.       (setq li (ssname ss (setq i (1- i))))
7.       (setq pl (mapcar 'cdr (vl-remove-if-not '(lambda ( x ) (vl-position (car x) '(10 11))) (setq lix (entget li)))))
8.       (setq p11 (list (* dx (if (minusp (caar pl)) (1- (fix (/ (caar pl) dx))) (fix (/ (caar pl) dx)))) (* dy (if (minusp (cadar pl)) (1- (fix (/ (cadar pl) dy))) (fix (/ (cadar pl) dy))))))
9.       (setq p12 (mapcar '+ p11 (list dx 0.0)))
10.       (setq p13 (mapcar '+ p11 (list dx dy)))
11.       (setq p14 (mapcar '+ p11 (list 0.0 dy)))
12.       (cond
13.         ( (= (distance p11 (car pl)) (distance p12 (car pl)) (distance p13 (car pl)) (distance p14 (car pl)))
14.           (setq p1 p11)
15.         )
16.         ( (and (= (distance p11 (car pl)) (distance p14 (car pl))) (< (distance p11 (car pl)) (distance p12 (car pl))))
17.           (setq p1 p11)
18.         )
19.         ( (and (= (distance p11 (car pl)) (distance p12 (car pl))) (< (distance p11 (car pl)) (distance p14 (car pl))))
20.           (setq p1 p11)
21.         )
22.         ( (and (= (distance p14 (car pl)) (distance p13 (car pl))) (< (distance p14 (car pl)) (distance p12 (car pl))))
23.           (setq p1 p14)
24.         )
25.         ( (and (= (distance p12 (car pl)) (distance p13 (car pl))) (< (distance p12 (car pl)) (distance p11 (car pl))))
26.           (setq p1 p12)
27.         )
28.         ( t
29.           (setq p1 (car (vl-sort (list p11 p12 p13 p14) '(lambda ( a b ) (< (distance a (car pl)) (distance b (car pl)))))))
30.         )
31.       )
32.       (setq p21 (list (* dx (if (minusp (caadr pl)) (1- (fix (/ (caadr pl) dx))) (fix (/ (caadr pl) dx)))) (* dy (if (minusp (cadadr pl)) (1- (fix (/ (cadadr pl) dy))) (fix (/ (cadadr pl) dy))))))
33.       (setq p22 (mapcar '+ p21 (list dx 0.0)))
34.       (setq p23 (mapcar '+ p21 (list dx dy)))
35.       (setq p24 (mapcar '+ p21 (list 0.0 dy)))
36.       (cond
37.         ( (= (distance p21 (cadr pl)) (distance p22 (cadr pl)) (distance p23 (cadr pl)) (distance p24 (cadr pl)))
38.           (setq p2 p21)
39.         )
40.         ( (and (= (distance p21 (cadr pl)) (distance p24 (cadr pl))) (< (distance p21 (cadr pl)) (distance p22 (cadr pl))))
41.           (setq p2 p21)
42.         )
43.         ( (and (= (distance p21 (cadr pl)) (distance p22 (cadr pl))) (< (distance p21 (cadr pl)) (distance p24 (cadr pl))))
44.           (setq p2 p21)
45.         )
46.         ( (and (= (distance p24 (cadr pl)) (distance p23 (cadr pl))) (< (distance p24 (cadr pl)) (distance p22 (cadr pl))))
47.           (setq p2 p24)
48.         )
49.         ( (and (= (distance p22 (cadr pl)) (distance p23 (cadr pl))) (< (distance p22 (cadr pl)) (distance p21 (cadr pl))))
50.           (setq p2 p22)
51.         )
52.         ( t
53.           (setq p2 (car (vl-sort (list p21 p22 p23 p24) '(lambda ( a b ) (< (distance a (cadr pl)) (distance b (cadr pl)))))))
54.         )
55.       )
56.       (setq lix (subst (cons 10 (reverse (cons 0.0 (reverse p1)))) (assoc 10 lix) lix))
57.       (setq lix (subst (cons 11 (reverse (cons 0.0 (reverse p2)))) (assoc 11 lix) lix))
58.       (entupd (cdr (assoc -1 (entmod lix))))
59.     )
60.   )
61.   (princ)
62. )
63.  

[Lee Mac]

Here's something similar:
https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/rounding-of-line-and-pline-vertices/m-p/4396563#M314796

[BIGAL]

Not sure if this is helpful but similar problem takes a point and rounds to a factor of the ah:spc used to pick random point but return a rounded value. used to create real world grid runs x & y.

Code: [Select]

(setq vc (getvar 'viewctr))
(setq cenx (car vc))
(setq ceny (cadr vc))
(setq  newcenx (rtos cenx 2 0))
(setq newcenintx  (substr newcenx 1 (- (strlen newcenx) lstr)))
(setq numrem  (fix (/ (atof (substr newcenx (- (strlen newcenx)(-  lstr 1)))) ah:spc)))
(if (= numrem 0)
(setq newcenintx  (atof (strcat newcenintx "00")))
(setq newcenintx (atof (strcat newcenintx (rtos (* numrem ah:spc) 2 0))))
)


[ahsattarian]

Try This Lisp   :





(defun c:ongrid   ()
  (defun sub1 (v1 m / v2) ;|  #round  |;
    (setq d (rem v1 m))
    (if   (> (abs d) (* m 0.5))
      (if (= d (abs d))
   (setq v2 (+ v1 (- m d)))
   (setq v2 (- v1 (- m (abs d))))
      )
      (setq v2 (- v1 d))
    )
    v2
  )
  (defun sub2 (enj1 ass)
    (setq enj2 nil)
    (foreach a enj1
      (cond
   ((= (car a) ass)
    (setq x1 (cadr a))
    (setq x2 (sub1 x1 sux))
    (setq y1 (caddr a))
    (setq y2 (sub1 y1 suy))
    (if (cadddr a)
      (setq a (list ass x2 y2 (cadddr a)))
      (setq a (list ass x2 y2)) ;|  for lwpolyline  |;
    )
   )
      )
      (setq enj2 (append enj2 (list a)))
    )
    enj2
  )
  (defun sub3 () (entmod enew))
  (setq ss (ssget))
  (setq su (getvar "snapunit"))
  (setq sux (car su))
  (setq suy (cadr su))
  (setq n (sslength ss))
  (acet-ui-progress-init "Progress :" n)     ; #Progressbar 1/3
  (setq k -1)
  (repeat n
    (setq k (1+ k))
    (acet-ui-progress-safe (1+ k))        ; #Progressbar 2/3
    (setq s (ssname ss k))
    (setq en (entget s))
    (setq typ (strcase (cdr (assoc 0 en)) t)) ;|  #type  |;
    (setq ass72 nil)
    (cond ((assoc 72 en) (setq ass72 (cdr (assoc 72 en)))))
    (cond
      ((and (member typ '("text" "attdef")) (member ass72 '(1 2 4))) (setq enew (sub2 en 11)) (sub3))
      ((member typ '("arc" "circle"))
       (setq rad1 (cdr (assoc 40 en)))
       (setq rad2 (sub1 rad1 sux))
       (setq enew (subst (cons 40 rad2) (assoc 40 en) en))
       (setq enew (sub2 enew 10))
       (sub3)
      )
      ((or
    (member typ '("line" "trace" "solid"))
    (and (member typ '("text" "attdef")) (member ass72 '(0 3 5)))
       )
       (setq enew (sub2 en 10))
       (setq enew (sub2 enew 11))
       (sub3)
      )
      ((member typ '("solid" "trace")) (sub2 s 12) (sub2 s 13))
      ((= typ "polyline")
       (setq s1 (entnext s))
       (setq en1 (entget s1))
       (setq typ1 (cdr (assoc 0 en1)))
       (while (/= typ1 "seqend")
    (setq enew (sub2 en1 10))
    (sub3)
    (entupd (cdr (assoc -1 en1)))
    (setq s1 (entnext s1))
    (setq en1 (entget s1))
    (setq typ1 (strcase (cdr (assoc 0 en1)) t)) ;|  #type  |;
       )
      )
      (t (setq enew (sub2 en 10)) (sub3))
    )
  )
  (acet-ui-progress-done)           ; #Progressbar 3/3
  (setvar "gridmode" 1)
  (print " *** E N D *** ")
)