I have a subroutine that offsets entities on certain layers, relying on updating selection sets via points. However, when I try the subroutine on just 1 or the other of the red entities, it doesn't work, seemingly trying to select/offset nearby entities. Is that because the point values I'm relying on to update the selection set aren't very precise? Should I instead rely on xdata or something else? This seems to be the 1 weird edge case, it works for most other scenarios.
(defun c:OFFSETAUTO
( / miscOffset miscOSLayer mechOffset mechOSLayer ss1 ss2)
;;; HERE - work out bug (hypothesis: when ssget by pt, if zoomed out pts change (pts being used need to be more specific))
;;; Clean up code, make more readable, work w/ fewer selection sets if possible
;;; last steps:
; add undo marks (undo all & individual)
; turn CMDECHO off
(setvar "CMDECHO" 0)
; get current layer to set back to at end
(setq cLayer (getvar "CLAYER"))
; misc. and mech. obstructions offset vars
(setq
miscOffset 4
miscOSLayer "PV VENTS SKYLIGHTS ROOF DRAINS"
mechOffset 6
mechOSLayer "PV MECH EQUIP SETBACK"
)
; get current or prompt for selection set
(setq ss1 (ssget '((0 . "LINE,ARC,*POLYLINE,CIRCLE"))))
; get point list
(setq pointList (list))
(setq inc 0)
(repeat (sslength ss1)
(setq point (cdr (assoc 10 (entget (ssname ss1 inc)))))
; if circle, get point on circle's edge (center pt + rad)
(if (equal (cdr (assoc 0 (setq ent (entget (ssname ss1 inc))))) "CIRCLE")
(progn
(setq rad (cdr (assoc 40 ent)))
(setq x (nth 0 point))
(setq point (subst (+ rad x) x point))
)
)
(setq pointList (cons point pointList))
(setq inc (1+ inc))
)
; filter out circles and closed polylines from selection set to join
(setq inc 0)
(repeat (sslength ss1)
(setq eName (ssname ss1 inc))
(setq ent (entget eName))
(if
(or
(equal (cdr (assoc 0 ent)) "CIRCLE") ; if ent is circle
(equal (cdr (assoc 70 ent)) 1) ; if ent is closed
)
(ssdel eName ss1)
)
)
; join entities
(if (/= (sslength ss1) 0) (polylineJoin ss1))
; construct list of entity names of newly joined entities (includes circles and closed polylines that were filtered out before joining)
(setq eNameList (mapcar '(lambda (pt)
(progn
; (princ (entget (ssname (ssget pt) 0)))
(princ pt)
(ssname (ssget pt '((8 . "PV Mechanical Obstructions,PV Misc Obstructions"))) 0)
)
)
pointList
)
)
; remove duplicates
(setq eNameList (LM:Unique eNameList))
; initialize empty selection sets
(setq ss2 (ssadd))
(setq ss3 (ssadd))
; add newly joined entities to ss2
(foreach eName eNameList (ssadd eName ss2))
(setq ssnum 0)
(repeat (sslength ss2)
; Get entity name and assoc list for each entity
(setq ename (ssname ss2 ssnum))
(setq entList (entget ename))
; DEBUGGING - Print ename of each entity in ss
;|
(princ "\nEname:\n")
(princ ename)
|;
; DEBUGGING - Print elist of each entity in ss
;|
(princ "\nEntity:\n")
(princ entList)
|;
; if entity is on "PV Misc Obstructions" layer and is CIRCLE/LWPOLYLINE, offset it
(offsetHandler entList "PV Misc Obstructions" miscOffset miscOSLayer)
; if entity is on "PV Mechanical Obstructions" layer and is CIRCLE/LWPOLYLINE
(offsetHandler entList "PV Mechanical Obstructions" mechOffset mechOSLayer)
(ssadd (entlast) ss3)
; increment ssnum
(setq ssnum (1+ ssnum))
)
; trim entities
(smartTrim ss3)
; reset current layer
(setvar "CLAYER" cLayer)
; turn CMDECHO on
(setvar "CMDECHO" 1)
; exit quietly
(princ)
)
; POLYLINE JOIN - joins all joinable entities in selection set
; From Kent Cooper - https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/lines-to-pline-in-one-step/m-p/3539784/highlight/true#M305510
;;; SHOULD also return selection set of newly joined entities
;;; FIX in case someone selects only a circle
(defun polylineJoin
(pjss / *error* doc svn svv nextent pjinit inc edata pjent)
; VARLIST
;; INPUTS
;;; pjss - input selection set, must be filered before inputting: '((0 . "LINE,ARC,*POLYLINE")) (PICKSET)
;; LOCAL VARS
;;; *error* - local error handling function (SYM)
;;; doc - AutoCAD active document, for purposes of end/start undo mark (VLA-OBJECT)
;;; svn - system variable names (LIST)
;;; svv - system variable values (LIST)
;;; nextent - entity used as starting point to check for new entities to join (ENAME)
;;; pjinit - initial number starting for loop (INT)
;;; inc - for loop incrementer (INT)
;;; edata - entity definition data, for purposes of removing invalid entities or fixing joined entities (ASSOC LIST)
;;; pjent - entity to be deleted from selection set if invalid shape (ENAME)
;; NON-LOCAL VARS
;;;
; general error handling
(defun *error* (errmsg)
(if (not (wcmatch errmsg "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errmsg))
)
; reset system variables, end undo, exit quietly
(mapcar 'setvar svn svv)
(vla-endundomark doc)
(princ)
)
; if there is a valid selection set
(if pjss
(progn
; start undo mark
(vla-startundomark (setq doc (vla-get-activedocument (vlax-get-acad-object))))
; get initial system vars and next joining entity reference
(setq
svn '(cmdecho peditaccept)
svv (mapcar 'getvar svn)
nextent (entlast)
)
; loop through selection set
(repeat (setq pjinit (sslength pjss) inc pjinit)
; remove any 2D "heavy", 3D polylines, or splined/fitted 2D lines from selection set
(if
(and
(=
(cdr (assoc 0 (setq edata (entget (setq pjent (ssname pjss (setq inc (1- inc))))))))
"POLYLINE" ; 2D "heavy" or 3D Polyline
)
(=
(= (cdr (assoc 100 (reverse edata))) "AcDb3dPolyline"); 3D
(member (boole 1 6 (cdr (assoc 70 edata))) '(2 4)); splined or fitted 2D
)
)
(ssdel pjent pjss)
)
)
; turn off command echo, turn on peditaccept
(mapcar 'setvar svn '(0 1))
; in case of older polylines (extreme edge case)
(setvar 'plinetype 2)
; if the remaining selection set is valid
(if pjss
; join entities based on different scenarios
(cond
( (= pjinit (sslength pjss) 1); selected only one, and it qualifies
(command "_.pedit" pjss "_join" "_all" "" ""); join everything possible to it
); single-selection condition
( (> (sslength pjss) 1); more than one qualifying object
(command "_.pedit" "_multiple" pjss "" "_join" "0.0" "")
); multiple qualifying condition
((prompt "\nSingle object not viable, or no more than 1 of multiple selection viable."))
)
; else
(prompt "\nNothing viable selected.")
)
; look through entities in selection set to set arcs/lines back to arcs/lines (may have gotten converted to plines)
(while (setq nextent (entnext nextent))
(setq edata (entget nextent))
(if
(and
(= (cdr (assoc 90 edata)) 2) ; transformation of entity allowed
(not (vlax-curve-isClosed nextent))
)
(command "_.explode" nextent)
)
)
; reset system vars, end undo mark
(mapcar 'setvar svn svv)
(vla-endundomark doc)
)
(prompt "\nNo qualifying object(s) selected.")
)
(princ)
)
; UNIQUE - returns list with duplicates removed
; From Lee Mac - http://lee-mac.com/uniqueduplicate.html
(defun LM:Unique ( l )
(if l
(cons (car l)
(LM:Unique (vl-remove (car l) (cdr l)))
)
)
)
; OFFSETHANDLER - checks that entity is on correct layer and is CIRCLE/LWPOLYLINE, then offsets
(defun offsetHandler (entList entLayer osDist osLayer / entEname)
; VARLIST
;; INPUTS
;;; entList - offset entity definition (ASSOC LIST)
;;; entLayer - correct entity layer of entity to offset (STR)
;;; osDist - amount to offset by (INT)
;;; osLayer - layer of offset entity (STR)
;; LOCAL VARS
;;; entEname - entity name of entity to offset (ENAME)
; get ename of entity
(setq entEname (cdr (car entList)))
; if entity is on correct layer and is CIRCLE/LWPOLYLINE, offset
(if
(and
(equal
(cdr (assoc '8 entList))
entLayer
)
(wcmatch
(cdr (assoc '0 entList))
"CIRCLE,LWPOLYLINE"
)
)
; offset entity (if error in offset, run offsetOuterError func)
(progn
(setq errObject (vl-catch-all-apply 'offsetOuter
(list entEname osDist osLayer)
)
)
(if (vl-catch-all-error-p errObject)
(offsetOuterError entEname osDist osLayer)
)
)
)
)
; OFFSETOUTERERROR - for handling error of inner offset on entity too small, offsets given polyline or circle entity by given amount and on given layer & color
(defun offsetOuterError (eName osDist osLayer / offsetEList)
; VARLIST
;; INPUTS
;;; eName - entity name of entity to offset (ENAME)
;;; osDist - amount to offset by (INT)
;;; osLayer - offset layer (STR)
;; LOCAL VARS
;;; offsetEList - offset entity definition (ASSOC LIST)
; error handling version if vla-offset attempts to inner-offset an entity too small (offset wouldn't fit inside entity)
; convert entity name to vla-object, then offset by negative osDist amount
(vla-offset (vlax-ename->vla-object eName) (- osDist))
; get offset assoc list
(setq offsetEList (entget (entlast)))
; change offset layer
(setq offsetEList (subst (cons '8 osLayer)
(assoc '8 offsetEList)
offsetEList
)
)
(entmod offsetEList)
)
; OFFSETOUTER - offsets given polyline or circle entity by given amount and on given layer & color
(defun offsetOuter (eName osDist osLayer / originalArea offsetEName offsetArea offsetEList)
; VARLIST
;; INPUTS
;;; eName - entity name of entity to offset (ENAME)
;;; osDist - amount to offset by (INT)
;;; osLayer - offset layer (STR)
;; LOCAL VARS
;;; originalArea - area of entity to offset (REAL)
;;; offsetEName - entity name of offset entity (ENAME)
;;; offsetArea - area offset entity (REAL)
;;; offsetEList - offset entity definition (ASSOC LIST)
; inspired by Kent Cooper's offset subroutine (comparing offset area with entity area): https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/offset-multiple-objects-at-once/m-p/8172189/highlight/true#M372175
; convert entity name to vla-object, then offset by osDist amount
(vla-offset (vlax-ename->vla-object eName) osDist)
; get area of original entity
;; NOTE: For open entities, vla-get-area draws line between 2 unaligned points
;;;;;;;; If points are aligned, vla-get-area assumes rectangle
;;;;;;;; Algorithm should still work though
(setq originalArea (vla-get-area (vlax-ename->vla-object eName)))
; get area of offset
(setq offsetEName (entlast))
(setq offsetArea (vla-get-area (vlax-ename->vla-object offsetEName)))
; compare area of offset to area of original, delete and redo offset if offset area is smaller
(if (< offsetArea originalArea)
(progn
(entdel offsetEName)
(vla-offset (vlax-ename->vla-object eName) (- osDist))
)
)
; get new offset assoc list
(setq offsetEList (entget (entlast)))
; change offset layer
(setq offsetEList (subst (cons '8 osLayer)
(assoc '8 offsetEList)
offsetEList
)
)
(entmod offsetEList)
)
; SMARTTRIM - trims groups of entities on the same layer
(defun smartTrim (ss / ssMech inc ent eName ssMisc ssMiscRegion newEname regionToExplode ssMechRegion)
; split selection set into 1 ss for each layer
(setq ssMech (ssadd))
(repeat (setq inc (sslength ss))
(setq ent (entget (ssname ss (setq inc (1- inc)))))
(if (equal (cdr (assoc '8 ent))
"PV Mech Equip Setback"
)
(progn
(setq eName (cdr (assoc '-1 ent)))
(ssadd eName ssMech)
(ssdel eName ss)
)
)
)
; renaming
(setq ssMisc ss)
; trimming PV VENTS SKYLIGHTS ROOF DRAINS (make all offsets a REGION for purposes of UNIONing)
(command-s "_.-LAYER" "_SET" "PV Vents Skylights Roof Drains" "")
(setq ssMiscRegion (ssadd))
(repeat (setq inc (sslength ssMisc))
(setq ent (entget (ssname ssMisc (setq inc (1- inc)))))
(setq eName (cdr (assoc -1 ent)))
(command-s "_.REGION" eName "")
(setq newEname (entlast))
(ssadd newEname ssMiscRegion)
(ssdel eName ssMisc)
)
; free from memory
(setq ssMisc nil)
; UNION regions and EXPLODE
(command-s "_.UNION" ssMiscRegion "")
(setq regionToExplode (entlast))
(command-s "_.EXPLODE" regionToExplode "") ;;; HERE - explode not working
; trimming PV MECH EQUIP SETBACK - same as above
(command-s "_.-LAYER" "_SET" "PV Mech Equip Setback" "")
(setq ssMechRegion (ssadd))
(repeat (setq inc (sslength ssMech))
(setq ent (entget (ssname ssMech (setq inc (1- inc)))))
(setq eName (cdr (assoc -1 ent)))
(command-s "_.REGION" eName "")
(setq newEname (entlast))
(ssadd newEname ssMechRegion)
(ssdel eName ssMech)
)
(setq ssMech nil)
(command-s "_.UNION" ssMechRegion "")
(setq regionToExplode (entlast))
(command-s "_.EXPLODE" regionToExplode "") ;;; HERE - explode not working - could try getting entities to explode by points
)
