Ok, I have another one here, this is a modification of Alan's code with VovKa's modification in it:
;*************************************************************************************************************************
;| VERSION HISTORY **
**
IB - VERSION 1.0 **
01/06/10 **
BY: CHRIS WADE **
**
- Insert Blocks on lines, arcs, polylines, other blocks, circles, etc. **
- Type: **
- W - Cycles from 3-5 wires **
- A - Changes to Arrowheads **
- C - Continuation Block **
- E - Use endpoint of object **
- T - Type block name. **
**
;*************************************************************************************************************************|;
; Code Adapted from VovKa's modification of Alanjt's code at http://www.theswamp.org/index.php?topic=12813.msg369625#msg369625
; Alanjt's Original code is located at: http://www.theswamp.org/index.php?topic=12813.msg369597#msg369597
(defun c:IB (/ #Ent #Read *error* blobj Ang lastpt cpt bname w ws bscale sObj oLay Snap Spt *thisdrawing* *modelspace* *paperspace*)
;;Error routine adapted from:
;; --=={ Dynamic Text Curve Align }==-- ;;
;; AUTHOR: ;;
;; ;;
;; Copyright © Lee McDonnell, November 2009. All Rights Reserved. ;;
;; ;;
;; { Contact: Lee Mac @ TheSwamp.org, CADTutor.net } ;;
(defun *error* (msg)
(and blobj(or (and pLst (mapcar (function (lambda (x) (vlax-put blobj (car x) (cdr x)))) pLst)) (and (not (vlax-erased-p blobj)) (vla-delete blobj))))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(redraw)
(princ)
)
(setq TMP nil)
(vl-load-com)
(setq bname "3W")
(setq W 3)
(setq bscale (/ (getvar "dimscale") 96))
(vl-cmdf "._insert" bname)(command)
(setq *thisdrawing* (vla-get-activedocument
(vlax-get-acad-object)
) ;_ end of vla-get-activedocument
*modelspace* (vla-get-ModelSpace *thisdrawing*)
*paperspace* (vla-get-PaperSpace *thisdrawing*))
(and
(setq #Ent (nentselp "\nSelect Item to Insert Block On: "))
(vl-position (cdr (assoc 0 (entget (car #Ent))))
'("LWPOLYLINE" "ARC" "LINE" "CIRCLE" "ELLIPSE")
)
(setq #Read (caddr #Ent)
#Ent (entmakex (append (entget (car #Ent)) (list (cons 60 1))))
)
(setq Sobj (vlax-ename->vla-object #Ent)
oLay (vla-get-Layer Sobj))
(or (not #Read)
(not (vla-transformby Sobj (vlax-tmatrix #Read)))
)
(not
(while (not (eq 25 (car (setq #Read (grread T 15 0)))))
(princ "\rSpecify point for block ([W]ires/[A]rrow/[C]ontinuation block/[T]ype block name/[E]ndpoint): ")
(redraw)
(cond
((eq 3 (car #Read))
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq blobj (vla-InsertBlock *modelspace* (vlax-3d-point Spt) bname bscale bscale bscale Ang))
(setq blobj (vla-InsertBlock *paperspace* (vlax-3d-point Spt) bname bscale bscale bscale Ang))
)
(vla-put-Layer blobj oLay)
)
((and (= (car #Read) 2) (or (= (cadr #Read) 101) (= (cadr #Read) 69)))
(if (/= Snap "_End")
(setq Snap "_End")
(setq Snap nil)
)
)
((and (= (car #Read) 2) (or (= (cadr #Read) 119) (= (cadr #Read) 87)))
(if (< W 5)
(setq W (+ W 1))
(setq W 3)
)
(setq WS (rtos W 2 0))
(setq bname (strcat WS "W"))
(vl-cmdf "._insert" bname)(command)
(setq Snap nil)
)
((and (= (car #Read) 2) (or (= (cadr #Read) 65) (= (cadr #Read) 97)))
(cond
((= bname "hr")
(setq bname "hr2-11")
(setq Snap "_End")
)
(T
(setq bname "hr")
(setq Snap nil)
)
)
(vl-cmdf "._insert" bname)(command)
)
((and (= (car #Read) 2) (or (= (cadr #Read) 99) (= (cadr #Read) 67)))
(setq bname "cb")
(vl-cmdf "._insert" bname)(command)
(setq Snap "_End")
)
((and (= (car #Read) 2) (or (= (cadr #Read) 116) (= (cadr #Read) 84)))
(setq bname nil)
(while (or (= bname nil) (= bname ""))
(setq bname (getstring T "\nEnter Block Name: "))
)
(vl-cmdf "._insert" bname)(command)
(setq Snap nil)
)
(T
(if (vl-consp (cadr #Read))
(progn
(if (= lastpt nil)
(setq lastpt (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T))
(progn
(setq cpt (vlax-curve-getclosestpointto #Ent (trans (cadr #Read) 1 0) T))
(setq data (trans (cadr #Read) 1 0))
(setq Ang (+ (angle data cpt) (D2R 90)))
(if (/= snap nil)
(setq Spt (osnap cpt Snap))
(setq Spt cpt)
)
(if (/= Spt nil)
(progn
(if (/= blobj nil)
(if (not (vlax-erased-p blobj)) (vla-delete blobj))
)
(if (or (/= (getvar "cvport") 1) (/= (getvar "tilemode") 0))
(setq blobj (vla-InsertBlock *modelspace* (vlax-3d-point Spt) bname bscale bscale bscale Ang))
(setq blobj (vla-InsertBlock *paperspace* (vlax-3d-point Spt) bname bscale bscale bscale Ang))
)
)
)
(vla-put-Layer blobj oLay)
)
)
)
)
)
)
)
)
(entdel #Ent)
)
(redraw)
(princ)
)
; Convert value in radians to degrees
(defun R2D (nbrOfRadians)
(* 180.0 (/ nbrOfRadians pi))
)
; Convert value in degrees to radians
(defun D2R (numberOfDegrees)
(* pi (/ numberOfDegrees 180.0))
) ;_ end of defun
(defun c:ktst ()
(while
(setq input (grread t 4 4))
(princ "\n")
(princ (cadr input))
)
)
The only problem that I am having is that if the object that you are inserting on is not closed, and you move the cursor off of the object, the block can get inserted in space (this seems to happen with the perpendicular line in the original code as well), any ideas on how to fix this?