Place block on both ends of all lines

[kareemuddin]

Hello,

 

can someone help me with a lisp I have a block which I want to place (block) on both ends of all lines using lisp

 

I have also attached image showing the same for better understanding

 

thanks in advance

[rkmcswain]

Will any of the lines share a common endpoint?

If so, will you want one or two blocks there?

[Grrr]

(defun-q C:BlockOnBothEndsOfLine nil
 ( '( ( f L ) (if L (apply (function f) (cons 0 L))))
   '( (i a b c / tmp)
     (and
       (setq tmp (ssname b i))
       (setq tmp (entget tmp))
       (mapcar ''( (x) (vlax-invoke c 'InsertBlock (cdr (assoc x tmp)) a 1 1 1 0)) '(10 11))
       (f (1+ i) a b c)
     )
   )
   ( '( (f L / tmp) (if (= (length L) (length (setq tmp (f L)))) tmp))
     '( ( L / tmp ) (if (and L (setq tmp (eval (car L)))) (cons tmp (f (cdr L)))) )
     '(
       ('((v) (if (and v (member '(0 . "INSERT") (entget v)))  (vla-get-EffectiveName (vlax-ename->vla-object v)))) (car (entsel "\nPick the block: ")))
       (progn (princ "\nSelect the lines: ") (ssget '((0 . "LINE"))))
       ( '((f)(f (vlax-get-acad-object) (reverse '(Block ActiveLayout ActiveDocument))))
         (lambda ( o L / tmp) (if (setq tmp (car L))  (f (vlax-get o tmp) (cdr L)) o ))
       )
     )
   )
 )
 (princ)
)

[ronjonp]

Another for grins

(defun c:foo (/ e o s tmp)
 (if (and (setq e (car (entsel "\nSelect a block to copy: ")))
   (vlax-write-enabled-p (setq o (vlax-ename->vla-object e)))
   (vlax-property-available-p o 'insertionpoint)
   (setq s (ssget '((0 . "line"))))
     )
   (foreach l (vl-remove-if 'listp (mapcar 'cadr (ssnamex s)))
     (mapcar '(lambda (x)
	 (and (not (vl-position x tmp))
	      (setq tmp (cons x tmp))
	      (setq o (vla-copy o))
	      (vlax-put o 'insertionpoint x)
	 )
       )
      (list (vlax-curve-getstartpoint l) (vlax-curve-getendpoint l))
     )
   )
 )
 (princ)
)
(vl-load-com)

Edited April 24, 2018 by ronjonp

[Tharwat]

Hi,

Simply this.

(defun c:test (/ pck sel int ent get bnm)
 (and
   (setq pck (car (entsel "\nPick on the target block :")))
   (or (and (= (cdr (assoc 0 (setq get (entget pck)))) "INSERT")
            (null (assoc 66 get))
       )
       (alert "Invalid object. Try again.<!>")
   )
   (princ
     (strcat "\nSelect Polyline/Line(s) to place <"
             (setq bnm (vla-get-effectivename (vlax-ename->vla-object pck)))
             "> at their Endpoints :"
     )
   )
   (setq int -1
         sel (ssget '((0 . "LINE,LWPOLYLINE")))
   )
   (while (setq ent (ssname sel (setq int (1+ int))))
     (foreach p (list (vlax-curve-getstartpoint ent) (vlax-curve-getendpoint ent))
       (entmake (list '(0 . "INSERT") (cons 2 bnm) (cons 10 (trans p 0 1))))
     )
   )
 )
 (princ)
) (vl-load-com)

[hanhphuc]

OP is lucky 3 different methods

@grrr vla-InsertBlock method

@ronjonp vla-copy method & remove duplicates

@Tharwat entmake method nice & simple

[Tharwat]

Thanks hanhphuc.

Have a good day.

[ronjonp]

OP is lucky 3 different methods

@grrr vla-InsertBlock method

@ronjonp vla-copy method & remove duplicates

@Tharwat entmake method nice & simple

 

I chose the copy method so the block would retain its layer/scale/rotation etc...

[kareemuddin]

Thanks for sharing Grrr

[kareemuddin]

Thanks for sharing ronjonp

[kareemuddin]

Thanks for sharing Tharwat

[kareemuddin]

Yes, I am thankful for all the help guy's