Jump to content
ibrahem

lisp moves selected blocks to the nearest polyline

Recommended Posts

ibrahem

Hello, there,

 

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

 

thnx,

 

Share this post


Link to post
Share on other sites
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

 

 

 

Share this post


Link to post
Share on other sites
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)
)

Share this post


Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.


×
×
  • Create New...