Topic: Move objects' vertex round of 5

[HasanCAD]

We reciving drawings all objects vertex not drawen in proper way. We draft it again to be round of 5.

[ronjonp]

Why do your x values go from 0 to 120 and 69 to 190?

Here's a quick draft:

Code: [Select]

(defun c:foo (/ _rnd5 e)
  (defun _rnd5 (n)
    (if   (minusp n)
      (* 5 (fix (- (/ (float n) 5) 0.5)))
      (* 5 (fix (+ (/ (float n) 5) 0.5)))
    )
  )

  (if (setq e (car (entsel "\nPick something: ")))
    (entmod (mapcar '(lambda (x)
             (if (vl-position (car x) '(10 11))
          (append (list (car x)) (mapcar '_rnd5 (cdr x)))
          x
             )
           )
          (entget e '("*"))
       )
    )
  )
  (princ)
)

[Lee Mac]

Try this program, specifying a rounding tolerance of 5 

[HasanCAD]

Why do your x values go from 0 to 120 and 69 to 190?

Thanks ronjonp. I copied the objects 120 to show the deference thats it.

[HasanCAD]

Try this program, specifying a rounding tolerance of 5 

Great, Thanks LEE

[HasanCAD]

In some cases this habben.
Could the lisp point to the gap if equal 5?

[Lee Mac]

Try this program, specifying a rounding tolerance of 5 

Great, Thanks LEE

You're welcome 

In some cases this habben.
Could the lisp point to the gap if equal 5?

Try this program:

Code: [Select]

(defun c:showgaps ( / enx idx lst mod sel tmp vt1 vt2 xc1 )
    (if (null *gap*)
        (setq *gap* 5.0)
    )
    (initget 6)
    (if (setq mod (getreal (strcat "\nShow gaps less than <" (rtos *gap*) ">: ")))
        (setq *gap* mod)
        (setq mod *gap*)
    )
    (if (setq sel (ssget '((0 . "LINE,LWPOLYLINE"))))
        (progn
            (repeat (setq idx (sslength sel))
                (if (= "LINE" (cdr (assoc 0 (setq enx (entget (ssname sel (setq idx (1- idx))))))))
                    (setq lst (cons (list (cdr (assoc 10 enx)) (cdr (assoc 11 enx))) lst))
                    (setq lst (cons (list (cdr (assoc 10 enx)) (cdr (assoc 10 (reverse enx)))) lst))
                )
                (setq lst (cons (reverse (car lst)) lst))
            )
            (setq lst (vl-sort lst '(lambda ( a b ) (< (caar a) (caar b)))))
            (while
                (setq vt1 (car  lst)
                      xc1 (caar vt1)
                      lst (cdr  lst)
                      tmp lst
                )
                (while (and (setq vt2 (car tmp)) (< (- (caar vt2) xc1) mod))
                    (if
                        (and
                            (< (distance (car vt1) (car  vt2)) mod)
                            (not (equal  (car vt1) (car  vt2) 1e-10))
                            (not (equal  (car vt1) (cadr vt2) 1e-10))
                        )
                        (entmake
                            (list
                               '(00 . "CIRCLE")
                               '(08 . "Gaps!")
                               '(62 . 1)
                                (cons 40 (/ mod 2.0))
                                (cons 10 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car vt1) (car vt2)))
                            )
                        )
                    )
                    (setq tmp (cdr tmp))
                )
            )
        )
    )
    (princ)
)
If rounding to a tolerance of 5.0, you will need to show gaps less than or equal to 5*sqrt(2) i.e. 7.07

[HasanCAD]

I am trying to compine both of them in one lisp
But how to extract root of number?

Code: [Select]

(setq mod (+ (* m m) (* m m)))

Edit:
Is it correct?

Code: [Select]

(setq m 5.)
(setq mod (sqrt (+ (* m m) (* m m))))

[Lee Mac]

Combining both programs:

Code: [Select]

;; Round Vertices & Show Gaps  -  Lee Mac

(defun c:round ( / dxf enx idx key lst mod sel tmp vt1 vt2 xc1 )
    (setq dxf
       '(
            ("CIRCLE"     10 40)
            ("LINE"       10 11)
            ("LWPOLYLINE" 10)
            ("INSERT"     10)
            ("POINT"      10)
        )
    )           
    (if (null *tol*)
        (setq *tol* 5.0)
    )
    (initget 6)
    (if (setq mod (getreal (strcat "\nSpecify rounding tolerance <" (rtos *tol*) ">: ")))
        (setq *tol* mod)
        (setq mod *tol*)
    )
    (if (setq sel (ssget '((0 . "CIRCLE,LINE,LWPOLYLINE,INSERT,POINT"))))
        (progn
            (repeat (setq idx (sslength sel))
                (if (setq enx (entget (ssname sel (setq idx (1- idx))))
                          key (cdr (assoc (cdr (assoc 0 enx)) dxf))
                    )
                    (entmod (rounddxf key mod enx))
                )
            )
            (repeat (setq idx (sslength sel))
                (setq enx (entget (ssname sel (setq idx (1- idx)))))
                (if (wcmatch (cdr (assoc 0 enx)) "LINE,LWPOLYLINE")
                    (progn
                        (if (= "LINE" (cdr (assoc 0 enx)))
                            (setq lst (cons (list (cdr (assoc 10 enx)) (cdr (assoc 11 enx))) lst))
                            (setq lst (cons (list (cdr (assoc 10 enx)) (cdr (assoc 10 (reverse enx)))) lst))
                        )
                        (setq lst (cons (reverse (car lst)) lst))
                    )
                )
            )
            (setq lst (vl-sort lst '(lambda ( a b ) (< (caar a) (caar b))))
                  mod (+ 1e-8 (* mod (sqrt 2.0)))
            )
            (while
                (setq vt1 (car  lst)
                      xc1 (caar vt1)
                      lst (cdr  lst)
                      tmp lst
                )
                (while (and (setq vt2 (car tmp)) (< (- (caar vt2) xc1) mod))
                    (if
                        (and
                            (< (distance (car vt1) (car  vt2)) mod)
                            (not (equal  (car vt1) (car  vt2) 1e-10))
                            (not (equal  (car vt1) (cadr vt2) 1e-10))
                        )
                        (entmake
                            (list
                               '(00 . "CIRCLE")
                               '(08 . "Gaps!")
                               '(62 . 1)
                                (cons 40 (/ mod 2.0))
                                (cons 10 (mapcar '(lambda ( a b ) (/ (+ a b) 2.0)) (car vt1) (car vt2)))
                            )
                        )
                    )
                    (setq tmp (cdr tmp))
                )
            )
        )
    )
    (princ)
)

(defun rounddxf ( key mod lst / rtn )
    (foreach itm lst
        (if (member (car itm) key)
            (setq rtn (cons (cons (car itm) (roundvalue (cdr itm) mod)) rtn))
            (setq rtn (cons itm rtn))
        )
    )
    (reverse rtn)
)

(defun roundvalue ( val mod )
    (if (listp val)
        (mapcar '(lambda ( x ) (round x mod)) val)
        (round val mod)
    )
)

;; Doug Broad
(defun round ( value to )
    (setq to (abs to))
    (* to (fix (/ ((if (minusp value) - +) value (* to 0.5)) to)))
)
(princ)

[HasanCAD]

Thanks LEE

[Lee Mac]

Thanks LEE