;;; --------------------------------------------------------------------- ;;; VTXBLK-bgol.lsp ;;; Command: IBVX ;;; ;;; PURPOSE ;;; Inserts a copy of a chosen (non-attribute) block at every vertex of ;;; one or more selected polylines. Useful for marking boundary stones, ;;; survey markers, or direction-change points along a polyline. ;;; ;;; USAGE ;;; 1. Ensure the target block is already defined in the drawing. ;;; 2. Load this file (APPLOAD or drag-drop onto the drawing window). ;;; 3. Type IBVX at the command line and press Enter. ;;; 4. Select one or more polylines. ;;; 5. Type the name of the block to insert. ;;; 6. A copy of that block is inserted at every vertex of every ;;; selected polyline, on layer "BGOL-IBVX". ;;; ;;; NOTES ;;; - Per the source utility this is based on, blocks that contain ;;; attribute definitions are NOT supported; this routine checks ;;; the block definition and refuses to proceed if it contains any ;;; ATTDEF sub-entities. ;;; - Block scale and rotation default to 1/1/0; edit ;;; *bgol-ibvx-scale* and *bgol-ibvx-rot* below to change defaults. ;;; - This is an original, independently written implementation. ;;; It is INSPIRED by the general idea of vertex-based block ;;; insertion common in survey/boundary marking workflows, but the ;;; code, command name and file name here are new and are NOT ;;; copied from, nor identical to, any specific third-party ;;; product. ;;; ;;; --------------------------------------------------------------------- ;;; Developed and shared for the CAD community by: BGol Community ;;; Community website: https://bgol.in/ ;;; License: Open-source & free to use, modify, and share for all. ;;; Provided "as is", without warranty of any kind. ;;; --------------------------------------------------------------------- (vl-load-com) (setq *bgol-ibvx-scale* 1.0) (setq *bgol-ibvx-rot* 0.0) (defun BGOL:IBVX-EnsureLayer (lname / ) (if (not (tblsearch "LAYER" lname)) (entmake (list '(0 . "LAYER") '(100 . "AcDbSymbolTableRecord") '(100 . "AcDbLayerTableRecord") (cons 2 lname) '(70 . 0) '(62 . 5) ; blue '(6 . "Continuous"))) ) ) (defun BGOL:IBVX-HasAttdefs (blkname / bent bdata found) (setq found nil) (setq bent (tblobjname "BLOCK" blkname)) (if bent (progn (setq bent (entnext bent)) (while (and bent (not found)) (setq bdata (entget bent)) (if (= (cdr (assoc 0 bdata)) "ATTDEF") (setq found T) ) (setq bent (entnext bent)) ) ) ) found ) (defun BGOL:IBVX-InsertBlock (blkname pt lname scl rot / ) (entmake (list '(0 . "INSERT") '(100 . "AcDbEntity") (cons 8 lname) '(100 . "AcDbBlockReference") (cons 2 blkname) (cons 10 pt) (cons 41 scl) (cons 42 scl) (cons 43 scl) (cons 50 rot))) ) (defun C:IBVX ( / ss lname blkname n i ent obj coords m j pt cnt) (setq lname "BGOL-IBVX") (BGOL:IBVX-EnsureLayer lname) (setq ss (ssget '((0 . "LWPOLYLINE")))) (if ss (progn (setq blkname (getstring T "\nBlock name to insert at each vertex: ")) (cond ((not (tblsearch "BLOCK" blkname)) (princ (strcat "\nBlock \"" blkname "\" is not defined in this drawing. Nothing inserted.")) ) ((BGOL:IBVX-HasAttdefs blkname) (princ (strcat "\nBlock \"" blkname "\" contains attribute definitions. " "This routine only supports non-attribute blocks. Nothing inserted.")) ) (t (setq n (sslength ss)) (setq i 0) (setq cnt 0) (while (< i n) (setq ent (ssname ss i)) (setq obj (vlax-ename->vla-object ent)) (setq coords (vlax-invoke obj 'Coordinates)) (setq m (/ (length coords) 2)) (setq j 0) (while (< j m) (setq pt (list (nth (* 2 j) coords) (nth (1+ (* 2 j)) coords))) (BGOL:IBVX-InsertBlock blkname pt lname *bgol-ibvx-scale* *bgol-ibvx-rot*) (setq cnt (1+ cnt)) (setq j (1+ j)) ) (setq i (1+ i)) ) (princ (strcat "\n" (itoa cnt) " block(s) inserted at polyline vertices (BGOL-IBVX).")) ) ) ) (princ "\nNo polylines selected.") ) (princ) ) (princ "\nVTXBLK-bgol.lsp loaded. Type IBVX to insert a block at every vertex of selected polylines.") (princ "\n -- Free & open-source, courtesy of BGol Community (https://bgol.in/) --") (princ)