lisp moves selected blocks to the nearest polyline

[ibrahem]

Hello, there,

 

I want a help for a lisp that  moves selected blocks to the nearest polyline and adding vertexes on it.

 

thnx,

 

[BIGAL]

Post a sample dwg before - after, this has been asked before to move block to pline, did you google  or search here ?

 

There are a couple of questions. 

use block insertion point or point in block

rotate block square to pline

inside or outside

 

 

 

[Emmanuel Delay]

Something like this?

 

Command MBP

 

;; test of (apv)
(defun c:apv ( / p)
  (setq p (getpoint "\nPick Point for New Vertex: "))
  (apv p)
)

;;----------------=={ Add LWPolyline Vertex }==---------------;;
;;                                                            ;;
;;  Adds a new vertex to an LWPolyline at a point specified   ;;
;;  by the user; compatible with LWPolylines at any           ;;
;;  orientation, with varying width and arc segments.         ;;
;;------------------------------------------------------------;;
;;  Author: Lee Mac, Copyright © 2012 - www.lee-mac.com       ;;
;;------------------------------------------------------------;;
;;  Version 1.0    -    17-12-2012                            ;;
;;                                                            ;;
;;  First release.                                            ;;
;;------------------------------------------------------------;;

;; based on Lee Mac's  Add LWPolyline Vertex
;; http://www.lee-mac.com/addpolyvertex.html
;; I (Emmanuel Delay) isolated the user selecting of the point out of the function

(defun apv (p / a b e h l n r w x z )
    (while
        (progn
            ;; (setq p (getpoint "\nPick Point for New Vertex: "))
            (cond
                (   (null p) nil)
                (   (null (setq e (nentselp p)))
                    (princ "\nPoint does not lie on an LWPolyline.")
                )
                (   (= 4 (length e))
                    (princ "\nObject is Nested.")
                )
                (   (/= "LWPOLYLINE" (cdr (assoc 0 (entget (setq e (car e))))))
                    (princ "\nObject is not an LWPolyline.")
                )
            )
        )
    )
    (if (and p e
            (setq p (vlax-curve-getclosestpointto e (trans p 1 0))
                  n (vlax-curve-getparamatpoint e p)
            )
        )
        (if (not (equal n (fix n) 1e-8))
            (progn
                (setq e (entget e)
                      h (reverse (member (assoc 39 e) (reverse e)))
                      l (LM:LWVertices e)
                      z (assoc 210 e)
                )
                (repeat (fix n)
                    (setq a (cons (car l) a)
                          l (cdr l)
                    )
                )
                (setq x (car l)
                      r (- n (fix n))
                      w (cdr (assoc 40 x))
                      w (+ w (* r (- (cdr (assoc 41 x)) w)))
                      b (atan (cdr (assoc 42 x)))
                )
                (entmod
                    (append h
                        (apply 'append (reverse a))
                        (list
                            (assoc 10 x)
                            (assoc 40 x)
                            (cons  41 w)
                            (cons  42 (tan (* r b)))
                        )
                        (list
                            (cons  10 (trans p 0 (cdr z)))
                            (cons  40 w)
                            (assoc 41 x)
                            (cons  42 (tan (* (- 1.0 r) b)))
                        )
                        (apply 'append (cdr l))
                        (list z)
                    )
                )
            )
        )
    )
    (princ)
)

;; Tangent  -  Lee Mac
;; Args: x - real

(defun tan ( x )
    (if (not (equal 0.0 (cos x) 1e-10))
        (/ (sin x) (cos x))
    )
)

;; LW Vertices  -  Lee Mac
;; Returns a list of lists in which each sublist describes
;; the position, starting width, ending width and bulge of the
;; vertex of a supplied LWPolyline

(defun LM:LWVertices ( e )
    (if (setq e (member (assoc 10 e) e))
        (cons
            (list
                (assoc 10 e)
                (assoc 40 e)
                (assoc 41 e)
                (assoc 42 e)
            )
            (LM:LWVertices (cdr e))
        )
    )
)

(vl-load-com) (princ)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Move blocks to the closest polyline and put a vertex there
(defun c:mbp ( / blocks plines b pl p1 p2 i j min_dist pc)
  (princ "\nSelect blocks: " )
  (setq blocks (ssget (list (cons 0 "INSERT"))))
  (princ "\nSelect polyline: " )
  (setq plines (ssget (list (cons 0 "POLYLINE,LWPOLYLINE"))))
  (setq i 0)
  (repeat (sslength blocks)
    (setq b (ssname blocks i))
    (setq p1 (cdr (assoc 10 (entget b))))  ;; insert point of block
    (setq min_dist nil)
    (setq j 0)
    (repeat (sslength plines)
      (setq pl (ssname plines j))
      (setq p2 (vlax-curve-getclosestpointto (vlax-ename->vla-object pl) p1))  ;; closest point to polyline (from the inset point)
      (princ "\n")
      (if (or (= min_dist nil) (< (distance p1 p2) min_dist )) (progn
        (setq min_dist (distance p1 p2))
        (setq pc p2)  ;; closest point
      ))
      (setq j (+ j 1))
    )
    ;; move blocks
    (command "._move" b "" p1 pc)
    ;; put a vertex there
    (apv pc)
    (setq i (+ i 1))
  )
  (princ)
)