Insert Block at Intersections


;;------------=={ Insert Block at Intersections }==-----------;;
;; ;;
;; Prompts the user to select or specify a block to be ;;
;; inserted, and make a selection of intersecting objects. ;;
;; Proceeds to insert the specified block at all points of ;;
;; intersection between all objects in the selection. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2012 - http://www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; Saved from: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/insert-block-at-intersection/m-p/4522675#M315888

(defun c:ins ( / *error* a b bfn blk cmd i j sel spc )

(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)

(while
(progn
(setvar 'errno 0)
(initget "Name Browse Exit")
(setq sel (entsel "\nSelect block to insert [Name/Browse] : "))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (or (null sel) (= "Exit" sel))
nil
)
( (= "Browse" sel)
(if (setq bfn (getfiled "Select Block" (getvar 'dwgprefix) "dwg" 16))
(if (null (tblsearch "block" (setq blk (cadr (fnsplitl bfn)))))
(progn
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(command "_.-insert" bfn nil)
(setvar 'cmdecho cmd)
(null (tblsearch "block" blk))
)
)
(princ "\n*Cancel*")
)
)
( (= "Name" sel)
(while
(not
(or (= "" (setq blk (getstring t "\nSpecify block name : ")))
(tblsearch "block" blk)
)
)
(princ "\nBlock not found.")
)
(= "" blk)
)
( (= 'list (type sel))
(if (= "INSERT" (cdr (assoc 0 (entget (car sel)))))
(setq blk (LM:blockname (vlax-ename->vla-object (car sel))))
(princ "\nObject is not a block.")
)
)
)
)
)

(if
(and
(= 'str (type blk))
(tblsearch "block" blk)
(setq sel (ssget))
)
(progn
(setq spc
(vlax-get-property (LM:acdoc)
(if (= 1 (getvar 'cvport))
'paperspace
'modelspace
)
)
)
(LM:startundo (LM:acdoc))
(repeat (setq i (sslength sel))
(setq a (vlax-ename->vla-object (ssname sel (setq i (1- i)))))
(if (vlax-method-applicable-p a 'intersectwith)
(repeat (setq j i)
(setq b (vlax-ename->vla-object (ssname sel (setq j (1- j)))))
(if (vlax-method-applicable-p b 'intersectwith)
(foreach p (LM:intersections a b acextendnone)
(vla-insertblock spc (vlax-3D-point p) blk 1.0 1.0 1.0 0.0)
)
)
)
)
)
(LM:endundo (LM:acdoc))
)
)
(princ)
)

;; Intersections - Lee Mac
;; Returns a list of all points of intersection between two objects
;; obj1,obj2 - VLA-Objects with the intersectwith method applicable
;; mode - acextendoption enum of intersectwith method

(defun LM:intersections ( obj1 obj2 mode / l r )
(setq l (vlax-invoke obj1 'intersectwith obj2 mode))
(repeat (/ (length l) 3)
(setq r (cons (list (car l) (cadr l) (caddr l)) r)
l (cdddr l)
)
)
(reverse r)
)

;; Block Name - Lee Mac
;; Returns the true (effective) name of a supplied block reference

(defun LM:blockname ( obj )
(if (vlax-property-available-p obj 'effectivename)
(defun LM:blockname ( obj ) (vla-get-effectivename obj))
(defun LM:blockname ( obj ) (vla-get-name obj))
)
(LM:blockname obj)
)

;; Start Undo - Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)

;; End Undo - Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)

;; Active Document - Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)

(vl-load-com) (princ)
(c:ins)

Insert Block on Points


;;; Insert Block on Points
;;; Created by rogerio_brazil
;;; Saved from: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lisp-to-convert-points-to-blocks/td-p/1652793
;;; Slightly modified by Igal Averbuh 2017 (added option to select block on screen)

(defun c:BOP (/ #cmdecho blkname ss scale idx n entname edata)
(command "undo" "begin")
(setq #cmdecho (getvar "cmdecho"))
(setvar "cmdecho" 0)

(setq ent (car (entsel "\nSelect Block Entity: ")))
(setq blkname (cdr (assoc 2 (entget ent))))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(princ (strcat "Block Name:"
(vla-get-effectivename
(vlax-ename->vla-object ent))))

;(setq blkname (getstring "\n Block name : "))
(if (= blkname "")(setq blkname "Block"))
(setq ss (ssget '((0 . "POINT"))))
(if ss
(progn
(setq scale (getreal "\n Block Scale : "))
(if (= scale nil)(setq scale 1))
(setq idx 0)
(setq n (sslength ss))
(repeat n
(setq entname (ssname ss idx))
(setq edata (entget entname))
(entmake (list (cons 0 "INSERT")
(cons 2 blkname)
(assoc 10 edata)
(assoc 8 edata)
(cons 41 scale)
(cons 42 scale)
(cons 43 scale)
(cons 50 0)
)
)
(entdel entname)
(setq idx (1+ idx))
)
(princ "\n\n Done!")
)
(princ "\n Not point(s) selected(s)!")
)
(setvar "cmdecho" #cmdecho)
(command "undo" "end")
(princ))

Copy Object (block) on Points


;;; Copy Object (block) on points
;;; Created by mdhutchinson
;;; Saved from: https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/replace-point-with-block-object/td-p/2157479
;;; Slightly modified by Igal Averbuh 2017 (added option to select needful points)

(defun c:Rp()
(command "undo" "begin")
(princ "\nSelect Points: ")
(setq ss (ssget '((0 . "POINT"))))
;(setq ss (ssget "x" (list (cons 0 "point"))))
(setq inc 0)
(setq obj (car (entsel "\nSelect an Object to locate at each Selected point: ")))
(setq orgpnt (cdr (assoc '10 (entget obj))))
(while (setq node (ssname ss inc))
(setq topnt (cdr (assoc '10 (entget node))))
(command "copy" obj "" orgpnt topnt)
(setq inc (1+ inc))
)
(princ "\nDone")
(command "undo" "end")
)
;(c:rp)

Copy selected entities and paste it as block in one command


;;--------------------=={ Change Block Base Point }==-------------------;;
;; ;;
;; This program allows the user to change the base point for all ;;
;; block references of a block definition in a drawing. ;;
;; ;;
;; The program offers two commands: ;;
;; ;;
;; ------------------------------------------------------------------ ;;
;; CBP (Change Base Point) ;;
;; ------------------------------------------------------------------ ;;
;; ;;
;; This command will retain the insertion point coordinates for all ;;
;; references of the selected block. Hence visually, the block ;;
;; components will be moved around the insertion point when the ;;
;; base point is changed. ;;
;; ;;
;; ------------------------------------------------------------------ ;;
;; CBPR (Change Base Point Retain Reference Position) ;;
;; ------------------------------------------------------------------ ;;
;; ;;
;; This command will retain the position of the each block reference ;;
;; of the selected block. Hence, each block reference will be moved ;;
;; to retain the visual position when the base point is changed. ;;
;; ;;
;; ------------------------------------------------------------------ ;;
;; ;;
;; Upon issuing a command syntax at the AutoCAD command-line, the ;;
;; program will prompt the user to select a block for which to change ;;
;; the base point. ;;
;; ;;
;; Following a valid selection, the user is then prompted to specify ;;
;; a new base point relative to the selected block. ;;
;; ;;
;; The block definition (and block reference depending on the command ;;
;; used) will then be modified to reflect the new block base point. ;;
;; ;;
;; If the selected block is attributed, an ATTSYNC operation will ;;
;; also be performed to ensure all attributes are in the correct ;;
;; positions relative to the new base point. ;;
;; ;;
;; Finally, the active viewport is regenerated to reflect the changes ;;
;; throughout all references of the block. ;;
;; ;;
;; The program will furthermore perform successfully with rotated & ;;
;; scaled block references, constructed in any UCS plane. ;;
;; ;;
;; ------------------------------------------------------------------ ;;
;; Please Note: ;;
;; ------------------------------------------------------------------ ;;
;; ;;
;; A REGEN is required if the UNDO command is used to undo the ;;
;; operations performed by this program. ;;
;; ;;
;;----------------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2013 - http://www.lee-mac.com ;;
;;----------------------------------------------------------------------;;
;; Version 1.5 - 20-10-2013 ;;
;;----------------------------------------------------------------------;;

;; Retains Insertion Point Coordinates
(defun c:cbp nil (LM:changeblockbasepoint nil))

;; Retains Block Reference Position
(defun c:cbpr nil (LM:changeblockbasepoint t))

;;----------------------------------------------------------------------;;

(defun LM:changeblockbasepoint ( flg / *error* bln cmd ent lck mat nbp vec )

(defun *error* ( msg )
(foreach lay lck (vla-put-lock lay :vlax-true))
(if (= 'int (type cmd)) (setvar 'cmdecho cmd))
(LM:endundo (LM:acdoc))
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
(princ (strcat "\nError: " msg))
)
(princ)
)

(while
(progn (setvar 'errno 0) (setq ent (entlast))
(cond
( (= 7 (getvar 'errno))
(princ "\nMissed, try again.")
)
( (= 'ename (type ent))
(if (/= "INSERT" (cdr (assoc 0 (entget ent))))
(princ "\nSelected object is not a block.")
)
)
)
)
)
(if (and (= 'ename (type ent)) (setq nbp (getpoint "\nSpecify New Base Point: ")))
(progn
(setq mat (car (revrefgeom ent))
vec (mxv mat (mapcar '- (trans nbp 1 0) (trans (cdr (assoc 10 (entget ent))) ent 0)))
bln (LM:blockname (vlax-ename->vla-object ent))
)
(LM:startundo (LM:acdoc))
(vlax-for lay (vla-get-layers (LM:acdoc))
(if (= :vlax-true (vla-get-lock lay))
(progn
(vla-put-lock lay :vlax-false)
(setq lck (cons lay lck))
)
)
)
(vlax-for obj (vla-item (vla-get-blocks (LM:acdoc)) bln)
(vlax-invoke obj 'move vec '(0.0 0.0 0.0))
)
(if flg
(vlax-for blk (vla-get-blocks (LM:acdoc))
(if (= :vlax-false (vla-get-isxref blk))
(vlax-for obj blk
(if
(and
(= "AcDbBlockReference" (vla-get-objectname obj))
(= bln (LM:blockname obj))
(vlax-write-enabled-p obj)
)
(vlax-invoke obj 'move '(0.0 0.0 0.0) (mxv (car (refgeom (vlax-vla-object->ename obj))) vec))
)
)
)
)
)
(if (= 1 (cdr (assoc 66 (entget ent))))
(progn
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(vl-cmdf "_.attsync" "_N" bln)
(setvar 'cmdecho cmd)
)
)
(foreach lay lck (vla-put-lock lay :vlax-true))
(vla-regen (LM:acdoc) acallviewports)
(LM:endundo (LM:acdoc))
)
)
(princ)
)

;; RefGeom (gile)
;; Returns a list whose first item is a 3x3 transformation matrix and
;; second item the object insertion point in its parent (xref, block or space)

(defun refgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(mapcar '(lambda ( v ) (trans v 0 ocs t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
(mxm
(list
(list (cos ang) (- (sin ang)) 0.0)
(list (sin ang) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(list
(list (cdr (assoc 41 enx)) 0.0 0.0)
(list 0.0 (cdr (assoc 42 enx)) 0.0)
(list 0.0 0.0 (cdr (assoc 43 enx)))
)
)
)
)
(mapcar '- (trans (cdr (assoc 10 enx)) ocs 0)
(mxv mat (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx))))))
)
)
)

;; RevRefGeom (gile)
;; The inverse of RefGeom

(defun revrefgeom ( ent / ang enx mat ocs )
(setq enx (entget ent)
ang (cdr (assoc 050 enx))
ocs (cdr (assoc 210 enx))
)
(list
(setq mat
(mxm
(list
(list (/ 1.0 (cdr (assoc 41 enx))) 0.0 0.0)
(list 0.0 (/ 1.0 (cdr (assoc 42 enx))) 0.0)
(list 0.0 0.0 (/ 1.0 (cdr (assoc 43 enx))))
)
(mxm
(list
(list (cos ang) (sin ang) 0.0)
(list (- (sin ang)) (cos ang) 0.0)
'(0.0 0.0 1.0)
)
(mapcar '(lambda ( v ) (trans v ocs 0 t))
'(
(1.0 0.0 0.0)
(0.0 1.0 0.0)
(0.0 0.0 1.0)
)
)
)
)
)
(mapcar '- (cdr (assoc 10 (tblsearch "block" (cdr (assoc 2 enx)))))
(mxv mat (trans (cdr (assoc 10 enx)) ocs 0))
)
)
)

;; Matrix x Vector - Vladimir Nesterovsky
;; Args: m - nxn matrix, v - vector in R^n

(defun mxv ( m v )
(mapcar '(lambda ( r ) (apply '+ (mapcar '* r v))) m)
)

;; Matrix x Matrix - Vladimir Nesterovsky
;; Args: m,n - nxn matrices

(defun mxm ( m n )
((lambda ( a ) (mapcar '(lambda ( r ) (mxv a r)) m)) (trp n))
)

;; Matrix Transpose - Doug Wilson
;; Args: m - nxn matrix

(defun trp ( m )
(apply 'mapcar (cons 'list m))
)

;; Block Name - Lee Mac
;; Returns the true (effective) name of a supplied block reference

(defun LM:blockname ( obj )
(if (vlax-property-available-p obj 'effectivename)
(defun LM:blockname ( obj ) (vla-get-effectivename obj))
(defun LM:blockname ( obj ) (vla-get-name obj))
)
(LM:blockname obj)
)

;; Start Undo - Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)

;; End Undo - Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)

;; Active Document - Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)

;;----------------------------------------------------------------------;;

(vl-load-com)
;(princ
; (strcat
; "\n:: ChangeBlockBasePoint.lsp | Version 1.5 | \\U+00A9 Lee Mac "
; (menucmd "m=$(edtime,0,yyyy)")
; " http://www.lee-mac.com ::"
; ""
; ""
; ""
; )
;)
(princ)

;;----------------------------------------------------------------------;;
;; End of File ;;
;;----------------------------------------------------------------------;;

;;; Copy selected entities and paste it as block in one command
;;; Created by Henrique hmsilva http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/copy-and-paste-as-block/td-p/6022554
;;; Modified by Igal Averbuh 2017 (entlast modification of Lee Mak routine)
(defun c:cpb (/ ss)
(command "ucs" "w")
(setvar "cmdecho" 0)
(setvar "osmode" 167)
(command "-layer" "u" "*" "")
(princ "\nSelect objects to copy and paste as block:")
(setq ss (ssget))

(command "_.copybase" '(0.0 0.0 0.0) ss "" "_.pasteblock" '(0.0 0.0 0.0))
(command "erase" ss "")

(command "ucs" "previous")
(setvar "ucsicon" 1)
(setvar "cmdecho" 1)
(princ)
(c:CBPR)
)
;(c:cpb)

Block Offset with user specified offset distance, distance between blocks and Rotate Blocks Around it Base Point


;;; Block Offset with user specified offset distance, distance between blocks and nd Rotate Blocks Around it Base Point
;;; Created by Igal Averbuh 2017
;;; Inspired by some subroutines of different authors

(defun C:BOR ( / pl1 pl2 bname pt1 odist)

(vl-load-com)
(cond
((and
(setq ent (car (entsel "\nSelect Block Entity: ")))
(setq bname (cdr (assoc 2 (entget ent))))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(princ (strcat "Block Name:"
(vla-get-effectivename
(vlax-ename->vla-object ent)))))

))

; (setq bname (getstring "\nType Block name: "))
(setq pl1 (car (entsel "\nSelect polyline: ")))
(setq pt1 (getpoint "\nPick side to offset to: "))
(setq odist (getdist pt1 "\nDistance to offset Polyline:"))
(setq odist1 (getdist pt1 "\nDistance between Blocks:"))
(command "_offset" odist pl1 pt1 "")
(setq pl2 (entlast))
(command "_measure" pl2 "_b" bname "_y" odist1)

(setq ss (ssget "P"))
(if (not ss) (setq ss (ssx)))
(setq num (sslength ss))
(setq x 0)
(if ss
(if (setq ang (getreal "Enter Rotation Angle: "))
(repeat num
(setq ename (ssname ss x))
(setq elist (entget ename))
(setq pnt (cdr(assoc 10 elist)))
(command "Rotate" ename "" pnt ang)
(setq x (1+ x))
)
)
)
)

(c:bor)

Measure by selected Block with user specified distance between blocks and Rotate Blocks Around it Base Point


;;; Measure by selected Block with user specified distance between blocks and Rotate Blocks Around it Base Point
;;; Created by Igal Averbuh 2017
;;; Inspired by some subroutines of different authors

(defun C:MBL ( / pl1 pl2 bname pt1 odist)

(vl-load-com)
(cond
((and
(setq ent (car (entsel "\nSelect Block Entity: ")))
(setq bname (cdr (assoc 2 (entget ent))))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(princ (strcat "Block Name:"
(vla-get-effectivename
(vlax-ename->vla-object ent)))))

))

(setq pl1 (car (entsel "\nSelect polyline: ")))

(setq odist1 (getdist "\nDistance between Blocks:"))

(command "_measure" pl1 "_b" bname "_y" odist1)

(setq ss (ssget "P"))
(if (not ss) (setq ss (ssx)))
(setq num (sslength ss))
(setq x 0)
(if ss
(if (setq ang (getreal "Enter Rotation Angle: "))
(repeat num
(setq ename (ssname ss x))
(setq elist (entget ename))
(setq pnt (cdr(assoc 10 elist)))
(command "Rotate" ename "" pnt ang)
(setq x (1+ x))
)
)
)
)

(c:mbl)

Measure by selected Block with user specified distance between blocks


;;; Measure by selected Block with user specified distance between blocks
;;; Created by Igal Averbuh 2017
;;; Inspired by some subroutines of different authors

(defun C:MBL ( / pl1 pl2 bname pt1 odist)

(vl-load-com)
(cond
((and
(setq ent (car (entsel "\nSelect Block Entity: ")))
(setq bname (cdr (assoc 2 (entget ent))))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(princ (strcat "Block Name:"
(vla-get-effectivename
(vlax-ename->vla-object ent)))))

))

(setq pl1 (car (entsel "\nSelect polyline: ")))

(setq odist1 (getdist "\nDistance between Blocks:"))

(command "_measure" pl1 "_b" bname "_y" odist1)
)
(c:mbl)

Draw Circles on user selected blocks, convert selected circles to polylines and change it width


;;; Draw Circles on user selected blocks, convert selected circles to polylines and change it width
;;; Based on Kent Cooper approach
;;; https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/draw-multiple-circles-using-a-point-selection-set/td-p/3112918
;;; Combined and slightly modified by Igal Averbuh 2017
;; CirclePolylineSwap.lsp [command names: C2P & P2C]
;; Two commands, to convert in both directions between Circles and
;; circular Polylines. Both commands:
;; 1. filter User selection for only appropriate objects on unlocked Layers;
;; 2. remove selected/converted objects, but can be edited to retain them;
;; 3. account for different Coordinate Systems;
;; 4. apply selected objects' non-default and/or non-Bylayer colors, line-
;; types, linetype scales, lineweights, and/or thicknesses to conversions.
;; See additional notes above each command's definition.
;; Kent Cooper, last edited 25 February 2015

;; C2P
;; To convert selected Circle(s) to two-equal-arc-segment closed zero-
;; width Polyline circle(s) [Donut(s) w/ equal inside & outside diameters],
;; which can then be modified as desired [given width, etc.], since Pedit
;; will not accept selection of Circles to convert them.
; Slightly modified by Averbuh Igal 2017 (added option to change width of ellipses)
(defun C:C2P1 (/ *error* doc conv csel cir cdata cctr crad pdata)

(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(vla-endundomark doc)
); defun -- *error*

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(setq conv 0)
(prompt "\nTo convert Circle(s) to Polyline equivalent(s),")
(setq converted (ssadd))
(if (setq csel (ssget "X" '((0 . "CIRCLE")))); User selection
(progn
(repeat (sslength csel); then
(setq
cir (ssname csel 0); Circle entity name
cdata (entget cir); entity data
cctr (cdr (assoc 10 cdata)); center point, OCS for Circle & LWPolyline w/ WCS 0,0,0 as origin
crad (cdr (assoc 40 cdata)); radius
pdata (vl-remove-if-not '(lambda (x) (member (car x) '(67 410 8 62 6 48 370 39))) cdata)
; start Polyline entity data list -- remove Circle-specific entries from
; Circle's entity data, and extrusion direction; 62 Color, 6 Linetype, 48
; LTScale, 370 LWeight, 39 Thickness present only if not default/bylayer
); setq
(entmake
(append ; add Polyline-specific entries
'((0 . "LWPOLYLINE") (100 . "AcDbEntity"))
pdata ; remaining non-entity-type-specific entries
(list
'(100 . "AcDbPolyline")
'(90 . 2); # of vertices
(cons 70 (1+ (* 128 (getvar 'plinegen)))); closed [the 1], and uses
; current linetype-generation setting; change above line to
; '(70 . 129) to force linetype generation on, '(70 . 1) to force it off
'(43 . 0.0); global width
(cons 38 (caddr cctr)); elevation in OCS above WCS origin [Z of Circle center]
(cons 10 (list (- (car cctr) crad) (cadr cctr))); vertex 1
'(40 . 0.0) '(41 . 0.0) '(42 . 1); 0 start & end widths, semi-circle bulge factor
(cons 10 (list (+ (car cctr) crad) (cadr cctr))); vertex 2
'(40 . 0.0) '(41 . 0.0) '(42 . 1)
(assoc 210 cdata) ; extr. dir. at end [if in middle, reverts to (210 0.0 0.0 1.0) in (entmake)]
); list
); append
); entmake
(ssdel cir csel)
(entdel cir); [remove or comment out this line to retain selected Circle(s)]
(ssadd (entlast) converted)
(setq conv (1+ conv))
); repeat -- then
(prompt (strcat "\n" (itoa conv) " Circle(s) converted to Polyline(s)."))
(command "select" converted "")
(sssetfirst nil converted)
(ssget "_I")
); progn -- then
(prompt "\nNo Circle(s) found [on unlocked Layer(s)]."); else
); if
(vla-endundomark doc)
(princ)
); defun

;; Polyline Width - Lee Mac
;; Applies a given constant width to all segments in a selection of polylines.

(defun c:psw ( / *error* idx sel wid )

(defun *error* ( msg )
(LM:endundo (LM:acdoc))
(if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
(princ (strcat "\nError: " msg))
)
(princ)
)

(LM:startundo (LM:acdoc))
(if
(setq sel (LM:ssget "\nSelect polylines: " '("P" ((0 . "LWPOLYLINE,POLYLINE")))))

(progn
(initget 4)
(setq wid (getdist (strcat "\nSpecify Width of Pline : ")))
(repeat (setq idx (sslength sel))
(vla-put-constantwidth (vlax-ename->vla-object (ssname sel (setq idx (1- idx)))) wid)
)
)
)
(*error* nil)
(princ)
)

;; ssget - Lee Mac
;; A wrapper for the ssget function to permit the use of a custom selection prompt
;; msg - [str] selection prompt
;; arg - [lst] list of ssget arguments

(defun LM:ssget ( msg arg / sel )
(princ msg)
(setvar 'nomutt 1)
(setq sel (vl-catch-all-apply 'ssget arg))
(setvar 'nomutt 0)
(if (not (vl-catch-all-error-p sel)) sel)
)

;; Start Undo - Lee Mac
;; Opens an Undo Group.

(defun LM:startundo ( doc )
(LM:endundo doc)
(vla-startundomark doc)
)

;; End Undo - Lee Mac
;; Closes an Undo Group.

(defun LM:endundo ( doc )
(while (= 8 (logand 8 (getvar 'undoctl)))
(vla-endundomark doc)
)
)

;; Active Document - Lee Mac
;; Returns the VLA Active Document Object

(defun LM:acdoc nil
(eval (list 'defun 'LM:acdoc 'nil (vla-get-activedocument (vlax-get-acad-object))))
(LM:acdoc)
)
(vl-load-com) (princ)

(Defun C:cib1 (/ SSblocks)

(vl-load-com)
(cond
((and
(setq ent (car (entsel "\nSelect Block Entity: ")))
(setq blkname (cdr (assoc 2 (entget ent))))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(princ (strcat "Block Name:"
(vla-get-effectivename
(vlax-ename->vla-object ent)))))

))
(setq wid (getdist (strcat "\nSpecify Circle Radius : ")))

(setq

SSblocks (ssget "X" (list (cons 2 blkname)))

)
(repeat (sslength SSblocks)
(command

"_.circle"

(cdr (assoc 10 (entget (ssname SSblocks 0)))); center

wid ; radius

); command
(ssdel (ssname SSblocks 0) SSblocks)

); repeat

(princ)
);defun

(defun C:cib ()
(setvar "osmode" 16384)

(setvar "orthomode" 0)

(c:cib1)
(c:c2p1)
(c:psw)

(setvar "osmode" 167)

(princ)
)

(c:cib)

Block Offset with user specified offset distance and distance between blocks


;;; Block Offset with user specified offset distance and distance between blocks
;;; Created by Igal Averbuh 2017
;;; Inspired by some subroutines of different authors

(defun C:BOF ( / pl1 pl2 bname pt1 odist)

(vl-load-com)
(cond
((and
(setq ent (car (entsel "\nSelect Block Entity: ")))
(setq bname (cdr (assoc 2 (entget ent))))
(eq (cdr (assoc 0 (entget ent))) "INSERT")
(princ (strcat "Block Name:"
(vla-get-effectivename
(vlax-ename->vla-object ent)))))

))

; (setq bname (getstring "\nType Block name: "))
(setq pl1 (car (entsel "\nSelect polyline: ")))
(setq pt1 (getpoint "\nPick side to offset to: "))
(setq odist (getdist pt1 "\nDistance to offset polyline:"))
(setq odist1 (getdist pt1 "\nDistance to offset Block:"))
(command "_offset" odist pl1 pt1 "")
(setq pl2 (entlast))
(command "_measure" pl2 "_b" bname "_y" odist1)
)
(c:bof)

Delete all dimensions in the all blocks


(defun c:dim (/ ss i sn name lst)
(vl-load-com)
;;; ------ Tharwat 15. June. 2012 ----- ;;;
;;; codes to delete all dimensions entities in the ;;;
;;; all blocks ;;;
(if (not acdoc)
(setq acdoc (vla-get-activedocument (vlax-get-acad-object)))
)
(if (setq ss (ssget "X" '((0 . "INSERT"))))
(repeat (setq i (sslength ss))
(setq sn (ssname ss (setq i (1- i))))
(if (not (member (setq name (cdr (assoc 2 (entget sn)))) lst))
(progn
(setq lst (cons name lst))
(vlax-for each (vla-item (vla-get-blocks acdoc) name)
(if (eq (vla-get-objectname each) "AcDbRotatedDimension")
(vla-delete each))
)
)
)
)
(princ)
)
(if ss (vla-regen acdoc AcAllviewports))
(princ)
)
(c:dim)