Author Topic: Move insert point of selected blocks to nearest polyline end point  (Read 116 times)

0 Members and 1 Guest are viewing this topic.

jtm2018hyo

  • Newt
  • Posts: 72
1) I need to select some blocks and  move then to the nearest end point of selected polyline.
2) I need to select some polyline and move theirs end points to the nearest selected block insert point.

This is possible?

ribarm

  • Water Moccasin
  • Posts: 2239
  • Marko Ribar, architect
Re: Move insert point of selected blocks to nearest polyline end point
« Reply #1 on: February 12, 2020, 04:24:01 AM »
Here, try this routine :

Code - Auto/Visual Lisp: [Select]
  1. (defun c:stretch-move-blks-lws ( / ssblks sslws ch dpl spl lwx dm d np npl k lwxn pl p )
  2.   (while
  3.     (or
  4.       (prompt "\nSelect block INSERT references on unlocked layer(s)...")
  5.       (not (setq ssblks (ssget "_:L" '((0 . "INSERT")))))
  6.     )
  7.     (prompt "\nEmpty sel. set...")
  8.   )
  9.   (while
  10.     (or
  11.       (prompt "\nSelect LWPOLYLINES on unlocked layer(s)...")
  12.       (not (setq sslws (ssget "_:L" '((0 . "LWPOLYLINE")))))
  13.     )
  14.     (prompt "\nEmpty sel. set...")
  15.   )
  16.   (initget 1 "Stretch Move")
  17.   (setq ch (getkword "\nStretch LWPOLYLINE vertices to nearest BLOCKS or move BLOCKS to nearest LWPOLYLINE vertices [Stretch/Move] : "))
  18.   (if (= ch "Stretch")
  19.     (progn
  20.       (setq dpl (apply 'append (mapcar '(lambda ( x ) (mapcar 'cdr (vl-remove-if '(lambda ( y ) (/= (car y) 10)) x))) (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssblks)))))))
  21.       (foreach lw (vl-remove-if 'listp (mapcar 'cadr (ssnamex sslws)))
  22.         (setq spl (mapcar '(lambda ( x ) (trans (list (car x) (cadr x) (cdr (assoc 38 lwx))) lw 0)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (setq lwx (entget lw))))))
  23.         (foreach p spl
  24.           (setq dm 1e+99)
  25.           (foreach pp dpl
  26.             (if (< (setq d (distance p pp)) dm)
  27.               (setq dm d np pp)
  28.             )
  29.           )
  30.           (setq npl (cons np npl))
  31.         )
  32.         (setq npl (reverse npl))
  33.         (setq npl (mapcar '(lambda ( x ) (trans x 0 lw)) npl))
  34.         (setq k -1)
  35.         (foreach x lwx
  36.           (if (= (car x) 10)
  37.             (setq lwxn (append lwxn (list (cons 10 (nth (setq k (1+ k)) npl)))))
  38.             (setq lwxn (append lwxn (list x)))
  39.           )
  40.         )
  41.         (entupd (cdr (assoc -1 (entmod lwxn))))
  42.         (setq npl nil lwxn nil)
  43.       )
  44.     )
  45.     (progn
  46.       (foreach lw (vl-remove-if 'listp (mapcar 'cadr (ssnamex sslws)))
  47.         (setq pl (mapcar '(lambda ( x ) (trans (list (car x) (cadr x) (cdr (assoc 38 lwx))) lw 0)) (mapcar 'cdr (vl-remove-if '(lambda ( x ) (/= (car x) 10)) (setq lwx (entget lw))))))
  48.         (setq dpl (append pl dpl))
  49.       )
  50.       (foreach blk (vl-remove-if 'listp (mapcar 'cadr (ssnamex ssblks)))
  51.         (setq dm 1e+99)
  52.         (foreach pp dpl
  53.           (if (< (setq d (distance (if (null p) (setq p (cdr (assoc 10 (entget blk)))) p) pp)) dm)
  54.             (setq dm d np pp)
  55.           )
  56.         )
  57.         (setq p nil)
  58.         (entupd (cdr (assoc -1 (entmod (subst (cons 10 np) (assoc 10 (entget blk)) (entget blk))))))
  59.       )
  60.     )
  61.   )
  62.   (princ)
  63. )
  64.  

M.R.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

jtm2018hyo

  • Newt
  • Posts: 72
Re: Move insert point of selected blocks to nearest polyline end point
« Reply #2 on: February 12, 2020, 10:14:14 PM »
awesome. thanks a lot.

how can I mark your answer as a solution?
« Last Edit: February 12, 2020, 10:19:41 PM by jtm2018hyo »