I have rewritten my command for inserting blocks on lines, arcs, etc. that automatically rotates the block to align with the curve.
My new routine is now much faster and should be more reliable, but before I send it out to my users I would like to ask the experts here if I am missing anything.
I ask because I used to use some code from others and now I believe all of the code is mine, but I am wondering if maybe I managed to miss something as their code was a lot more complex.
I have attached the old code as an attachment, I have also attached the new blocks as an attachment. Any input would be greatly appreciated.
;*************************************************************************************************************************
;| VERSION HISTORY **
**
IB - VERSION 2.0 **
07/19/18 **
BY: CHRIS WADE **
**
- Insert Blocks on lines, arcs, polylines, other blocks, circles, etc. **
- Completely rewritten from scratch **
- Runs faster **
- Type: **
- W - Cycles from 3-6 wires **
- A - Changes to Arrowheads **
- C - Continuation Block **
- E - Use endpoint of object **
- O - Type block name or select block **
**
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. **
**
;*************************************************************************************************************************|;
(defun c:IB (/ *ThisDrawing* *Space* Scale Ent Pt1 Pt2 Pt3 Data Code Input Ang Obj Rot *Prompt* BlObj)
(defun *error* (msg)
(eraseold BlObj)
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(redraw)
(princ)
)
;Supporting Routines
; 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 EraseOld (Obj /);Erases the previous version of a VLA object
(if Obj
(progn
(if (not (vlax-erased-p Obj))
(vla-delete Obj)
)
)
)
)
;End of Supporting Routines
(defun GetVportScale ()
(/ 1 (vla-get-CustomScale (vla-get-ActivePViewport (vla-get-activedocument (vlax-get-acad-object)))))
)
(vl-load-com)
(princ "\n")
(while (not Ent)
(setq Ent (nentselp "\rSelect object to insert block on:"))
(if
(not
(or (= "VERTEX" (cdr (assoc 0 (entget (car Ent)))))
(not (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list (car Ent)))))
)
)
(progn
(princ "\nInvalid object selected.\n")
(setq Ent nil)
)
)
)
(setq Pt1 (trans (cadr Ent) 1 0)
Obj (vlax-ename->vla-object (car Ent))
)
(if (not BlkName)
(setq BlkName "3WIRE")
)
(if (not W)
(setq W 3)
)
(command "._insert" BlkName)(command)
(setq *ThisDrawing* (vla-get-activedocument (vlax-get-acad-object)) ;_ end of vla-get-activedocument
*Space*
(if (zerop (vla-get-activespace *ThisDrawing*))
(if (= (vla-get-mspace *ThisDrawing*) :vlax-true)
(vla-get-modelspace *ThisDrawing*) ; active VP
(vla-get-paperspace *ThisDrawing*)
)
(vla-get-modelspace *ThisDrawing*)
)
)
(if (zerop (vla-get-activespace *ThisDrawing*))
(if (= (vla-get-mspace *ThisDrawing*) :vlax-true)
(setq Scale (GetVportScale))
(setq Scale 1.0)
)
(setq Scale (getvar "DimScale"))
)
(princ "\n")
(while
(If (= Snap "_End")
(setq *Prompt* "\rSelect insertion point [Wires/Arrow/Continuation/Other/** Endpoint **]:")
(setq *Prompt* "\rSelect insertion point [Wires/Arrow/Continuation/Other/Endpoint]:")
)
(princ *Prompt*)
(setq Input (grread t 15 0)
Data (cadr Input)
Code (car Input)
)
(cond
((and (= Code 2) (or (= Data 69) (= Data 101)))
(if (= Snap "_End")
(setq Snap nil)
(setq Snap "_End")
)
)
((and (= Code 2) (or (= Data 79) (= Data 111)))
(setq BlkName nil)
(while (or (not BlkName) (= BlkName ""))
(setq BlkName (getstring T "\nEnter Block Name [enter to select file]: "))
(if (or (not BlkName) (= BlkName ""))
(progn
(setq BlkName (getfiled "Select a block" "H:\\0 - ACAD Support\\05 - Custom Commands" "dwg" 8))
(command "._insert" BlkName)(command)
(setq BlkName (vl-filename-base BlkName))
)
)
)
)
((and (= Code 2) (or (= Data 87) (= Data 119)))
(if (< W 6)
(setq W (+ W 1))
(setq W 3)
)
(setq BlkName (strcat (rtos W 2 0) "WIRE")
Snap nil
)
(command "._insert" BlkName)(command)
)
((and (= Code 2) (or (= Data 65) (= Data 97)))
(setq BlkName "arw"
Snap nil
)
(command "._insert" BlkName)(command)
)
((and (= Code 2) (or (= Data 67) (= Data 99)))
(setq BlkName "cbk"
Snap "_End"
)
(command "._insert" BlkName)(command)
)
((= Code 3)
(setq blobj nil)
)
(T
(setq Pt3 (trans Data 1 0)
Pt2 (vlax-curve-getclosestpointto Obj Pt3)
Ang (+ (angle Pt2 Pt3) (d2r 90))
)
(if Snap
(setq Pt2 (osnap Pt2 Snap))
)
(eraseold blobj)
(setq blobj (vla-InsertBlock *Space* (vlax-3d-point Pt2) BlkName Scale Scale Scale Ang))
(vla-put-layer BlObj (vla-get-layer Obj))
)
)
)
)
