Drawing lines from block insertion point to adjacent line

[tanvirme2k9]

Hi,

I have found a lisp that draws lines from the centre of the circles to adjacent line. Can someone modify it so that it can draw lines from block insertion point to adjacent line? Thanks in advance.

Spoiler

(defun c:foo (/ selection pline sscount objpline inspoint intpoint entity)
  (if (not (setq selection (ssget "_I" '((0 . "CIRCLE")))))
    (progn
      (prompt "\nSelect circles: ")
      (setq selection (ssget '((0 . "CIRCLE"))))
    )
  )
  (setq pline (entsel "\nSelect polyline: "))
  (if (and
	pline
	(setq objpline (vlax-ename->vla-object (car pline)))
      )
    (repeat (setq sscount (sslength selection))
      (setq
	entity	 (entget (ssname selection (setq sscount (1- sscount))))
	inspoint (cdr (assoc 10 entity))
	intpoint (vlax-curve-getclosestpointto objpline inspoint)
      )
      (if intpoint
	(command "_.line" "non" inspoint "non" intpoint "")
      )
    )
  )
)

[Kent1Cooper · Accepted solution]

Fortunately, the Insertion Point of a Block is stored in the same "slot" in its entity data as the center of a Circle, so it's a pretty simple addition of entity name:

(defun c:foo (/ selection pline sscount objpline inspoint intpoint entity)
  (if (not (setq selection (ssget "_I" '((0 . "CIRCLE,INSERT")))))
    (progn
      (prompt "\nSelect circles: ")
      (setq selection (ssget '((0 . "CIRCLE,INSERT"))))
    )
  )
  (setq pline (entsel "\nSelect polyline: "))
  (if (and
	pline
	(setq objpline (vlax-ename->vla-object (car pline)))
      )
    (repeat (setq sscount (sslength selection))
      (setq
	entity	 (entget (ssname selection (setq sscount (1- sscount))))
	inspoint (cdr (assoc 10 entity)); both center of Circle and insertion pt of Block
	intpoint (vlax-curve-getclosestpointto objpline inspoint)
      )
      (if intpoint
	(command "_.line" "non" inspoint "non" intpoint "")
      )
    )
  )
)

If you want only Blocks, and not both/either Circles and/or Blocks in the same command, use just "INSERT" instead of "CIRCLE,INSERT".

Either way, it would also accept other INSERT object types, such as Xrefs and some other oddball things [Windows Metafiles, for example] in the selection, but could be made fancier to accept only actual Block insertions, if needed.

[lgabriel]

Revised code. Changed ( 0 . CIRCLE) to ( 0 . INSERT) in order to select blocks instead of circles. let me know if this is what you were looking for

(defun c:foo (/ selection pline sscount objpline inspoint intpoint entity)
(vl-load-com)
  (if (not (setq selection (ssget "_I" '((0 . "INSERT")))))
    (progn
      (prompt "\nSelect blocks: ")
      (setq selection (ssget '((0 . "INSERT"))))
    )
  )
  (setq pline (entsel "\nSelect polyline: "))
  (if (and
 pline
 (setq objpline (vlax-ename->vla-object (car pline)))
      )
    (repeat (setq sscount (sslength selection))
      (setq
 entity  (entget (ssname selection (setq sscount (1- sscount))))
 inspoint (cdr (assoc 10 entity))
 intpoint (vlax-curve-getclosestpointto objpline inspoint)
      )
      (if intpoint
 (command "_.line" "non" inspoint "non" intpoint "")
      )
    )
  )
)

[tanvirme2k9]

Thank you man 🙂

[tanvirme2k9]

Thanks