;;; Draw a "buffer" boundary outline of User-specified width around User-selected Offsettable object(s)
;;; Created by Kent Cooper
;;; Saved from here: http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/buffer-lisp-code-around-pline/td-p/5489225

;|
BUFFER.lsp [command name: BF]
To put a "buffer" boundary outline of User-specified width around User-
selected Offsettable object(s).
Offsets selected object(s) by specified distance, on both sides of open-ended
objects, or for closed objects, User choice of both sides or outboard only [e.g.
wetlands perimeter would not need inboard buffer edge]. Outboard-only
would be equivalent to regular Offset, except BUFFER determines which
way is outboard without need for User designation, always rounds convex
corners of resulting Polylines, and remembers buffer width.
If object is open-ended [other than Xline], Offsets to both sides & wraps Arc(s)
around end(s) [for Ray, only one end], connecting ends of offset elements to
complete boundary. If object is a Line, Arc or non-Fit/Splined Polyline, joins
buffer boundary into one enclosing Polyline.
Option for resulting buffer boundary to be on same Layer as Source object
or on Current Layer.
Buffer width & Layer choices independent of regular Offset's distance/Layer
options, and are remembered and offered as default on subsequent use.
Under Both-ways option for closed objects, if Circle radius or closed Ellipse
minor radius is not greater than buffer width, goes outboard only.
If Arc or partial Ellipse radius is not greater than buffer width, does not go
inboard, but still wraps arcs around ends and if appropriate, trims to close.
Can fail or have unexpected results if Polyline/Spline has certain conditions,
e.g. self-intersection, or [relative to buffer width] too-tight curvature or too-
close interior approach or too-short end segment(s), or if Ellipse has minor
radius too close to buffer width, because Offsetting can either fail or result
in more than one object.
Kent Cooper, last edited 5 January 2017
|;
;;;;; [doesn't yet work for open objects in different UCS, though for many
;;;;; objects it will look as though it did from current point of view]

(defun C:BF
(/ *error* doc svnames svvals ss n ent edata closed new obj etype ang pton e1 e2)

(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
); if
(mapcar 'setvar svnames svvals); reset System Variables
(vla-endundomark doc)
(princ)
); defun - *error*

(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vla-startundomark doc)
(setq ; System Variable saving/resetting without separate variables for each:
svnames '(osmode cmdecho peditaccept offsetgaptype blipmode offsetdist)
svvals (mapcar 'getvar svnames)
); setq
(mapcar 'setvar svnames '(1 1 0)); throughout-routine SV's

(initget (if *bufferdist 0 1)); no Enter on first use
(setq
*bufferdist ; global variable
(cond
( (getdist ; returns nil on Enter
(strcat
"\nBuffer width"
(if *bufferdist (strcat " ") ""); prior-value default if present
": "
); strcat
); getdist
); User-input condition
(*bufferdist); prior value [if present] on Enter
); cond & *bufferdist
); setq
(initget "Current Source")
(setq *bufferlay ; global variable
(cond
( (getkword
(strcat
"\nLayer for buffer outlines [Current/Source] : "
); strcat
); getkword
); User-input condition
(*bufferlay); prior value if present on Enter
("Current"); initial-use default on Enter with no prior value **
; ** if "Source" preferred as initial default, EDIT in two places above
); cond
); setq

(prompt "\nTo add surrounding buffer outline(s),")
(if
(and
(setq ss (ssget "_:L" '((0 . "*LINE,ARC,CIRCLE,ELLIPSE,RAY"))))
; *LINE allows Line/Polyline [any kind]/Spline/Xline/Mline, but Mlines & 3D
; Polylines/Splines can't be offset, and don't want Polygon/Polyface Meshes, so:
(repeat (setq n (sslength ss))
(setq edata (entget (setq ent (ssname ss (setq n (1- n))))))
(if
(or
(member '(0 . "MLINE") edata)
(and
(member '(0 . "POLYLINE") edata); "heavy" type
(/= (logand 88 (cdr (assoc 70 edata))) 0); 8 = 3DPoly, 16 or 64 = mesh
); and
(not (vlax-curve-isPlanar ent)); 3D Spline
); or
(ssdel ent ss); then -- remove [returns reduced ss]
(if (vlax-curve-isClosed ent); else -- for Circle, closed Pline/Ellipse/Spline
(setq closed T); then -- marker for both-ways question later
T ; else [for non-nil return from (repeat) if last object is open]
); if [else]
); if
); repeat
(> (sslength ss) 0); valid object(s) remaining
); and
(progn ; then -- proceed
(mapcar 'setvar svnames (list 0 0 1 1 0 *bufferdist)); set System Variables
(if closed ; any remaining viable object(s) closed?
(progn
(initget "Both Outboard")
(setq *buffersides ; global variable
(cond
( (getkword
(strcat
"\nFor closed object, offset Both ways or Outboard only? [Both/Outboard] : "
); strcat
); getkword
); User-input condition
(*buffersides); prior value if present on Enter
("Outboard"); initial-use default on Enter with no prior value **
; ** if "Both" preferred as initial default, EDIT in two places above
); cond
); setq
); progn
); if
(repeat (setq n (sslength ss))
(setq
new (ssadd); initially empty for each
obj (vlax-ename->vla-object (ssname ss (setq n (1- n))))
etype (substr (vla-get-ObjectName obj) 5); without AcDb prefix
closed (vlax-curve-isClosed obj); [re-use variable name]
); setq
(if (= etype "Ray")
(progn ; then [by pick because (vla-offset) method not available]
(setq ang
(angle
(vlax-get obj 'BasePoint)
(setq pton (vlax-get obj 'SecondPoint))
; [less subject to seeing something else than end]
); angle
pickoffs (list (getvar 'aperture) (getvar 'aperture))
); setq
(while ; find pick location where Offset pick finds only this Ray
(> (sslength (ssget "_C" (mapcar '+ pton pickoffs) (mapcar '- pton pickoffs))) 1)
; more than one thing within Osnap Aperture range?
(setq pton (polar pton ang 1)); then -- move along Ray
); while
(command "_.offset" "" pton (polar pton (- ang (/ pi 2)) *bufferdist) "")
(setq e1 (entlast)) (ssadd e1 new)
(command "_.offset" "" pton (polar pton (+ ang (/ pi 2)) *bufferdist) "")
(setq e2 (entlast)) (ssadd e2 new)
); progn -- then
(progn ; else [all other types]
(vla-offset obj *bufferdist); always outboard of Arc/Circle/Ellipse
(setq e1 (entlast))
(if
(and
closed
(= *buffersides "Outboard")
(vla-object e1)) (vla-get-Area obj)); went inboard
); and
(entdel e1); then -- remove [other-way Offset wanted]
(ssadd e1 new); else
); if
(if ; Offset other way when applicable:
(cond
((wcmatch etype "Line,Xline"))
((= etype "Arc") (> (vlax-get obj 'Radius) *bufferdist)); big enough
((= etype "Circle")
(and
(> (vlax-get obj 'Radius) *bufferdist); big enough
(= *buffersides "Both"); if asked for [always closed]
); and
); Circle condition
((= etype "Ellipse")
(and
(> (vlax-get obj 'MinorRadius) *bufferdist); big enough
(if closed (= *buffersides "Both") T)
); and
); Ellipse condition
((not closed)); open-ended Polyline/Spline
((= *buffersides "Both")); closed Polyline/Spline
((not (entget e1))); Outboard-only option with closed Polyline/Spline
; first one was inboard under Outboard-only option, so deleted
; [if (entget) succeeds, e1 was already outboard -- don't go other way]
); cond
(progn ; second Offset
(vla-offset obj (- *bufferdist))
(setq e2 (entlast)) (ssadd e2 new)
); progn
); if
); progn -- else [other than Ray]
); if [Ray or otherwise]
(if (and (not closed) (/= etype "Xline"))
; open-ended object other than Xline -- wrap Arcs around ends
(progn ; then
(command
"_.arc" (vlax-curve-getStartPoint e1) "_c" (vlax-curve-getStartPoint obj)
; [spelling out "_cen[ter]" is taken as Osnap call]
"_angle"
(strcat
(if (= etype "Line") "" "-")
(angtos pi (getvar 'aunits) 8); any Units angle settings
); strcat
); command
(ssadd (entlast) new)
(if (/= etype "Ray"); other end for all but Ray
(progn ; then
(command
"_.arc" (vlax-curve-getEndPoint e1) "_c" (vlax-curve-getEndPoint obj)
"_angle"
(strcat
(if (= etype "Line") "-" "")
(angtos pi (getvar 'aunits) 8); any Units angle settings
); strcat
); command
(ssadd (entlast) new)
); progn
); if [not Ray]
(if (wcmatch etype "*Polyline,Line,Arc"); connectable with Pedit
; [In older versions, Fit-curved or Spline-curved 2D Polyline will LOSE curvature
; if PEDIT/Joined; if an issue, replace above (if... line with:
; (if
; (or
; (wcmatch etype "Line,Arc,Polyline"); always PEDIT/Joinable without loss
; (and
; (= etype "2dPolyline")
; (= (vlax-get obj 'Type) 0); NOT Fit- or Spline-curved
; ); and
; ); or
; In newer versions, could use JOIN also with Spline, Ellipse or such Plines, BUT:
; JOIN when in a (command) function does NOT allow multiple initial selection
; as command-line version does, but requires selecting one object first, after which
; expectations vary with combinations of entity types, etc., e.g. if Line selected first,
; can't JOIN Arc to it, or vice versa. If desired to use JOIN with other entity types
; than Lines/Arcs/"plain" Polylines joinable via PEDIT, do it manually afterwards.
; [As of Acad2016 -- may change in later versions.]
(progn ; then
(command "_.pedit" "_multiple" new "" "_join" "" ""); connect them
(ssadd (entlast) new)
); progn
); if [Pedit-Joinable or not]
(if
(and
(wcmatch etype "Arc,Ellipse")
(not closed); if Ellipse, partial [i.e. not full with Outboard-only option]
(not e2); did not go inboard [radius not more than buffer width]
); and
(if (= etype "Arc"); then -- trim end-wrapping arcs if needed
(if (not (vlax-curve-isClosed (setq e1 (entlast)))); [re-use variable name]
; with close-enough ends, PEDIT/Join sometimes trims to closed, but if not:
(command "_.trim" e1 "" ; then
(vlax-curve-getStartPoint e1) (vlax-curve-getEndPoint e1) ""
); command
); if [joined-Polyline result around Arc]
(if ; else [open Ellipse -- buffer not joined]
(vlax-invoke
(setq e1 (vlax-ename->vla-object (ssname new 1))); [re-use variable names]
; 1st Arc [0 is outward-Offset Spline]
'IntersectWith ; Arcs cross? [won't always with Ellipses as with Arcs]
(setq e2 (vlax-ename->vla-object (ssname new 2))); 2nd
acExtendNone
); vlax-invoke
(command "_.trim" new "" ; then
(vlax-curve-getStartPoint e1) (vlax-curve-getEndPoint e2)
); command
); if
); if [Arc vs. Ellipse]
); if [may need wrap-around-end Arcs trimmed]
); progn -- then
); if [open-ended non-Xline or otherwise]
(command "_.chprop" new "" "_layer"
(if (= *bufferlay "Source") (vla-get-Layer obj) (getvar 'clayer)) ""
); command
); repeat [through selection set]
); progn -- then
(prompt "\nNo Offsettable object(s) selected."); else
; [whether because of object type(s) or locked Layer(s)]
); if [valid selection or not]

(mapcar 'setvar svnames svvals); reset
(vla-endundomark doc)
(princ)
); defun

(vl-load-com)
(prompt "\nType BF to add buffer boundary outline(s) around object(s).")
(c:bf)