Divide angle defined by 3 points in drawing to number of parts are drawn from the vertex dividing the angle


;; Pick an angle by three points and choose the number of parts you want to divide the
;; angle into.Lines are drawn from the vertex dividing the angle.
;; Created by Lee Mak
;; Saved from: https://www.theswamp.org/index.php?action=post;quote=487487;topic=43500.0

(defun c:ad ( / a d n p q s v x )
(if (and
(setq v (getpoint "\nPick Angle Vertex: "))
(setq p (getpoint v "\nPick 1st Endpoint: "))
(setq q (getpoint v "\nPick 2nd Endpoint: "))
)
(progn
(initget 6)
(if (null (setq n (getint "\nSpecify Number of Divisions : ")))
(setq n 2)
)
(if (not (LM:Clockwise-p p v q))
(setq x p p q q x)
)
(setq a (/ (LM:GetInsideAngle p v q) n)
s (+ a (angle v p))
d (max (distance v p) (distance v q))
)
(repeat (1- n)
(entmake (list '(0 . "LINE") (cons 10 (trans v 1 0)) (cons 11 (trans (polar v s d) 1 0))))
(setq s (+ s a))
)
)
)
(princ)
)

;; Get Inside Angle - Lee Mac
;; Returns the smaller angle subtended by three points with vertex at p2

(defun LM:GetInsideAngle ( p1 p2 p3 )
( (lambda ( a ) (min a (- (+ pi pi) a)))
(rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi))
)
)

;; Clockwise-p - Lee Mac
;; Returns T if p1,p2,p3 are clockwise oriented

(defun LM:Clockwise-p ( p1 p2 p3 )
(< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
(* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
)
)

(c:ad)

Advertisements

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)

System variable that controls Shortcut Menus in the drawing area

This Is SHORTCUTMENU

Controls whether Default, Edit, and Command mode shortcut menus are available in the drawing area. The setting is stored as a bitcode using the sum of the following values:

0
Disables all Default, Edit, and Command mode shortcut menus, restoring AutoCAD Release 14 behavior.

1
Enables Default mode shortcut menus.

2
Enables Edit mode shortcut menus.

4
Enables Command mode shortcut menus whenever a command is active.

8
Enables Command mode shortcut menus only when command options are currently available from the command line.

16
Enables display of a shortcut menu when the right button on the pointing device is held down longer

My Lisp’s to toggle “shortcut menus in drawing area” on and off


(defun c:s0()
(command "SHORTCUTMENU""0")
(princ)
)

(defun c:s1()
(command "SHORTCUTMENU""1")
(princ)
)

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)

Convert selected Circles to Polylines with option to change Width of circles


;; 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 ":L" '((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

;; P2C
;; To convert selected closed all-arc-segment circular Polylines [e.g. Donuts, or
;; others if truly circular, including with more than two segments, of unequal
;; included angles, of varying widths] to true Circles. If any Polylines within
;; single selection set have non-zero global width, offers User option to draw
;; Circle along center-line or along inside or outside edge of width; applies
;; same position to all in selection, and retains choice for subsequent default.
;; Works on both old-style "heavy" 2D and newer "lightweight" Polylines.
;
(defun C:P2C
(/ *error* ptpar doc cmde conv notconv psel pl pdata ctr radlist ver plhw cpos pwadj cdata)

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

(defun ptpar (par); PoinT on polyline at specified PARameter value
(vlax-curve-getPointAtParam pl par)
); defun - ptpar

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(setq
cmde (getvar 'cmdecho); for possible ConvertPoly command later
conv 0
notconv 0
); setq
(prompt "\nTo convert Polyline circle(s) to true Circle(s),")
(if (setq psel (ssget ":L" '((0 . "*POLYLINE")))); User selection
(repeat (sslength psel); then
(setq pl (ssname psel 0)); first Polyline entity name
(if
(and
(vlax-curve-isClosed pl)
(setq pdata (entget pl))
(/= (cdr (assoc 100 (reverse pdata))) "AcDb3dPolyline"); not 3D
); and
(progn ; then -- closed LW/2D Polyline
(if (= (cdr (assoc 100 (reverse pdata))) "AcDb2dPolyline"); "heavy" 2D
(progn; then
(setvar 'cmdecho 0)
(command "_.convertpoly" "_light" pl ""); retains same entity name
(setvar 'cmdecho cmde)
(setq pdata (entget pl)); replace "heavy" Polyline entity data
); progn
); if -- 2D
(if
(and
(not (member '(42 . 0.0) pdata)); no line segments
(apply '= ; all arc segments bulge in same direction [no retracing]
(mapcar 'minusp
(mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) pdata))
); mapcar
); apply
); and
(progn ; then -- check for circularity
(setq
ctr
(mapcar '/
(mapcar '+
(vlax-curve-getStartPoint pl)
(vlax-curve-getPointAtDist ; point half-way around
pl
(/
(vlax-curve-getDistAtParam pl (vlax-curve-getEndParam pl))
2.0
); /
); getPointAtDist
); mapcar +
'(2 2 2)
); mapcar \ & ctr
radlist (list (distance ctr (vlax-curve-getStartPoint pl)))
ver 0
); setq
(repeat (* (cdr (assoc 90 pdata)) 2); check distance from ctr at all vertices & midpoints
(setq rad (distance ctr (ptpar (setq ver (+ ver 0.5))))); [depends on not being "quirky"]
(if (not (equal rad (car radlist) 1e-6)); different radius?
(setq radlist (cons rad radlist)); then -- add to list
); if
); repeat
(if (= (length radlist) 1); all distances from center the same = circular -- convert it
(progn ; then
(if (assoc 43 pdata); has global width
(if ; outer then
(and
(/= (setq plhw (/ (cdr (assoc 43 pdata)) 2)) 0); PolyLine Half-Width not zero
(not cpos); not established yet -- ask only once per selection set
); and
(progn ; inner then -- get Circle-position option
(initget "Center Inside Outside")
(setq
_P2Ccpos_ ; _global_ variable
(cond
((getkword
(strcat ; will apply same User choice to ALL conversions in selection set
"\nCircle position on Donut(s) [Center/Inside/Outside] : "
); strcat
)); getkword & first condition
(_P2Ccpos_); retain on Enter if default established
("Center"); default on first use
); cond & _P2Ccpos_
cpos T ; option established for subsequent Polylines this selection
); setq
); progn -- inner then -- wide global-width Polyline -- Circle placement option
); if -- outer then [global width]
(setq plhw 0); outer else [has varying widths -- use Center]
); if [global width or not]
(setq pwadj ; = Polyline Width ADJustment
(cond ; then -- first two equivalent to "Center" for zero-width or varying-width originals
((= _P2Ccpos_ "Outside") plhw)
((= _P2Ccpos_ "Inside") (- plhw))
(0); Center option or no wide global-width originals yet
); cond
); setq
(setq cdata (vl-remove-if-not '(lambda (x) (member (car x) '(67 410 8 62 6 48 370 39))) pdata))
; build circle entity data list -- remove Polyline-specific entries from
; Polyline's entity data, and extrusion direction; 62 Color, 6 Linetype, 48
; LTScale, 370 LWeight present only if not default/bylayer; 39 Thickness
(entmake
(append ; add circle-specific entries
'((0 . "CIRCLE") (100 . "AcDbEntity"))
cdata ; remaining non-entity-type-specific entries
(list
'(100 . "AcDbCircle")
(cons 10 (trans ctr 0 pl)); center -- WCS to OCS
(cons 40 (+ (car radlist) pwadj)); radius
(assoc 210 pdata); extr. dir. at end [if in middle, reverts to (210 0.0 0.0 1.0) in (entmake)]
); list
); append
); entmake
(entdel pl)
; [remove or comment out above line to retain selected
; Polyline -- will be left lightweight if originally heavy]
(setq conv (1+ conv))
); progn -- then
(setq notconv (1+ notconv)); else -- not circular
); if -- circular
); progn -- then
(setq notconv (1+ notconv)); else -- has line segment(s) or different-direction bulge(s)
); if -- no line segments, same bulge directions
); progn -- then
(setq notconv (1+ notconv)); else -- not closed or LW/2D
); if -- closed LW/2D
(ssdel pl psel)
); repeat -- then
(prompt "\nNo Polyline(s) found [on unlocked Layer(s)]."); else
); if -- User selection
(prompt
(strcat
"\n"
(if (> conv 0) (itoa conv) "No")
" Polyline(s) converted to Circle(s). "
(if (> notconv 0)
(strcat (itoa notconv) " Polyline(s) not circular and/or not closed.")
""
); if
); strcat
); prompt
(vla-endundomark doc)
(princ)
); defun

(vl-load-com)
(prompt "\nType C2P to convert Circle(s) to equivalent Polyline(s).")
(prompt "\nType P2C to convert circular Polyline(s) to equivalent Circle(s).")

;; 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:c2p ()
(setvar "osmode" 16384)

(setvar "orthomode" 0)

(c:c2p1)
(c:psw)

(setvar "osmode" 167)

(princ)
)

(c:c2p)

Convert Ellipses to Plines wth option to change width of ellipses


;Ellipses to Plines (c)1999, Oleg Khenson
;Slightly modified by Averbuh Igal 2017 (added option to change width of ellipses)

(defun C:E2P1 (/ A CEN CLA CMD DIS EN END_P1
END_P2 ENT I K LA LT M MINOR%
NM OLDERR OS PELMODE SS
)
(defun DXF (CODE ELIST) (cdr (assoc CODE ELIST)))
(defun EL2PL_ERR (S)
(if (/= S "Function cancelled")
(princ (strcat "\nError: " S))
)
(setvar "CMDECHO" CMD)
(if OS
(setvar "OSMODE" OS)
)
(setq *ERROR* OLDERR
OLDERR NIL
)
(princ)
)
(setq OLDERR *ERROR*
*ERROR* EL2PL_ERR
)
(setq CMD (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(setq converted (ssadd))
(princ "\nSelect Ellipses to be converted to PLines: ")
(setq SS (ssget '((0 . "ELLIPSE"))))
(command ".UNDO" "G")
(if SS
(progn
(setq OS (getvar "OSMODE"))
(setvar "OSMODE" 0)
(setq I 0
K 0
M 0
)
(repeat (sslength SS) ; for each entity from SS
(setq A (entget (setq NM (ssname SS I)
ENT NM
)
)
LA (DXF 8 A)
)
(if (< (cdr (assoc 70 (tblsearch "LAYER" LA))) 4)
(progn
(if (= (DXF 0 A) "ELLIPSE")
(progn
(setq LT (DXF 6 A)
CEN (DXF 10 A)
MINOR% (DXF 40 A)
END_P1 (mapcar '+ CEN (DXF 11 A))
DIS (distance CEN END_P1)
END_P2 (polar
CEN
(+ (angle CEN END_P1) (/ pi 2.0))
(* DIS MINOR%)
)
)
(setq PELMODE (getvar "PELLIPSE"))
(setvar "PELLIPSE" 1)
(setq CLA (getvar "CLAYER"))
(if (/= CLA LA)
(setvar "CLAYER" LA)
)
(command ".ELLIPSE"
"C"
(trans CEN 0 1)
(trans END_P1 0 1)
(trans END_P2 0 1)
)
(setq K (1+ K))
(setvar "PELLIPSE" PELMODE)
(entdel ENT)
(if (/= CLA (getvar "CLAYER"))
(setvar "CLAYER" CLA)
)
(if
(and LT
(/= (DXF 6 (tblsearch "LAYER" LA)) LT)
)
(progn (command ".CHPROP" "L" "" "LT" LT "")
(command ".PEDIT" "L" "L" "ON" "")
)
)
)
)
)
(setq M (1+ M))
)
(ssadd (entlast) converted)

(setq I (1+ I))

)
)
)
(command "select" converted "")

(setq *ERROR* OLDERR)
(command ".UNDO" "E")
(if OS
(setvar "OSMODE" OS)
)
(setvar "CMDECHO" CMD)
(princ)
(sssetfirst nil converted)
(ssget "_I")
)

;; 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:e2p ()
(setvar "osmode" 16384)

(setvar "orthomode" 0)

(c:e2p1)
(c:psw)

(setvar "osmode" 167)

(princ)
)

(c:e2p)

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)

Draw Grid Axes with axes numbering


; This function automates horizontal & vertical column grid lines at specified
; offsets. A column line bubble with number or letter is placed at the end of
; each centerline. Numbers or letters are sequentially incremented at each
; centerline. Dimension is performed between each column line.
; The orientation is bubbles on top and to the left of centerlines.
; Offsets top to bottom and left to right.
; Orginal program by Jeff Burner
; Slightly modified by Igal Averbuh 2017 (added option to set needful data by 2 points on screen)

(defun c:cg ()
(alert "Need to disable WinHEB in order to use this routine properly")
(setvar 'TEXTSIZE
(cond ((getdist (strcat "\nSpecify Text Height by 2 points : ")))
((getvar 'TEXTSIZE))
)
)

(setq CE (getvar "CMDECHO")
OM (getvar "ORTHOMODE")
TS (getvar "TEXTSIZE")
TH (rtos TS)
)

(setvar "CMDECHO" 0)
(setvar "ORTHOMODE" 0)
(if TS
(progn
(setq TXTHT (strcat "\nText Height: "))
(setq THT (atof (getstring TXTHT)))
(if (= THT 0.0) (setq STTXT TS) (setq STTXT THT))
)
)
(setq P1 (getpoint "\nEnter upper left grid intersection: "))
(setq XBAYN (getint "\nEnter no. of horizontal axes: "))
(setq YBAYN (getint "\nEnter no. of vertical axes: "))
(setq XBAYZ (getdist "\nEnter horizontal distance between axes: "))
(setq YBAYZ (getdist "\nEnter vertical distance between axes: "))
(setq DIR (* STTXT 3))
(setq RAD STTXT)
(setq XLEN (+ 192 (* YBAYZ YBAYN)))
(setq YLEN (+ 192 (* XBAYZ XBAYN)))
(setq XNUM 1)
(setq XP2 (list (car P1) (+ 96 (cadr P1))))
(setq XP3 (list (car XP2) (+ (/ DIR 2) (cadr XP2))))
(setq XP4 (list (car XP2) (+ DIR (cadr XP2))))
(setq XP5 (list (car XP2) (- (cadr XP2) XLEN)))
(command "TEXT" "M" XP3 STTXT "0" (rtos XNUM 2 0))
(command)
(command "CIRCLE" "2P" XP2 XP4)
(command "LINE" XP2 XP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq XINSTR XBAYZ)
(while (/= XBAYN 0.0)
(command "dim" "hor" (list (car XP2) (- (cadr XP2) RAD))
(list (+ (car XP2) XINSTR) (- (cadr XP2) RAD))
(list (+ (car XP2) XINSTR) (- (cadr XP2) RAD)) ""
)
(command)
(setq XP2 (list (+ (car XP2) XINSTR) (cadr XP2)))
(setq XP3 (list (car XP2) (+ (/ DIR 2) (cadr XP2))))
(setq XP4 (list (car XP2) (+ DIR (cadr XP2))))
(setq XP5 (list (car XP2) (- (cadr XP2) XLEN)))
(setq XNUM (+ XNUM 1))
(command "TEXT" "M" XP3 STTXT "0" (rtos XNUM 2 0))
(command)
(command "CIRCLE" "2P" XP2 XP4)
(command "LINE" XP2 XP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq XBAYN (- XBAYN 1))
)
(command)
(setq YNUM 65)
(setq LETR (chr YNUM))
(setq YP2 (list (- (car P1) 96) (cadr P1)))
(setq YP3 (list (- (car YP2) (/ DIR 2)) (cadr YP2)))
(setq YP4 (list (- (car YP2) DIR) (cadr YP2)))
(setq YP5 (list (+ (car YP2) YLEN) (cadr YP2)))
(command "TEXT" "M" YP3 STTXT "0" LETR)
(command)
(command "CIRCLE" "2P" YP2 YP4)
(command "LINE" YP2 YP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq YINSTR YBAYZ)
(while (/= YBAYN 0.0)
(command "dim" "vert" (list (+ (car YP2) RAD) (cadr YP2))
(list (+ (car YP2) RAD) (- (cadr YP2) YINSTR))
(list (+ (car YP2) RAD) (- (cadr YP2) YINSTR)) ""
)
(command)
(setq YP2 (list (car YP2) (- (cadr YP2) YINSTR)))
(setq YP3 (list (- (car YP2) (/ DIR 2)) (cadr YP2)))
(setq YP4 (list (- (car YP2) DIR) (cadr YP2)))
(setq YP5 (list (+ (car YP2) YLEN) (cadr YP2)))
(setq YNUM (+ YNUM 1))
(if (= YNUM 73) (setq YNUM 74))
(setq LETR (chr YNUM))
(command "TEXT" "M" YP3 STTXT "0" LETR)
(command)
(command "CIRCLE" "2P" YP2 YP4)
(command "LINE" YP2 YP5 "")
(command "change" "L" "" "P" "LT" "center" "")
(setq YBAYN (- YBAYN 1))
)
(command)
(princ)
(setvar "ORTHOMODE" OM)
(setvar "CMDECHO" CE)
)
(c:cg)