Implied selection set and joining help
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I'm writing a script to join and then offset various entities on certain layers. It works perfectly when running the command OFFSETAUTO without a selection set already made, but I want it to work for an implied selection set as well. Currently, it results in an "invalid selection" error for implied selection sets. Any tips on what I could improve on? You can see I've tried to clean up the selection set before feeding it to joinSegments (where I believe the error is), but no luck so far. Thanks in advance
(defun c:OFFSETAUTO ( / ss) ;;;;;; add all local vars
; better ss handling: delete and add entities to ss as needed
; add more detailed error handling
; advanced undo mark: named undo's, option to undo joining, all offsets, and/or a single offset (ordered in a certain way, like left to right & top to bottom)
; load all ActiveX and reactor support extended functions
(vl-load-com)
; general error handler
(defun *error* (errMessage)
; if not standard error (due to hitting ESC, for instance), print error
(if (not (wcmatch errMessage "Function cancelled,quit / exit abort,console break"))
(princ (strcat "\nError: " errMessage))
)
(vla-endundomark doc)
(princ)
)
; turn CMDECHO off if needed
(if (/= (getvar "CMDECHO") 0)
(progn
(setq cmdEcho (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
)
)
; getting ACAD object and active document for use with (vl-startundomark) and (vl-endundomark)
(setq acadObj (vlax-get-acad-object))
(setq doc (vla-get-ActiveDocument acadObj))
; misc. obstructions offset vars
(setq miscOffset 4) ; 4 inch misc. obstructions offset
(setq miscOSLayer "PV VENTS SKYLIGHTS ROOF DRAINS") ; layer of misc. obstructions offset
; mech. obstructions offset vars
(setq mechOffset 6) ; 6 inch mech. obstructions offset
(setq mechOSLayer "PV MECH EQUIP SETBACK") ; layer of misc. obstructions offset
; get current layer, color, lineweight, linetype to change back to after command ;;;;;;;;;;;;;;; method for getting current color, lweight/style
; maybe could get current color by accessing last made entity (might have issues if entlast doesn't work for a new drawing session)
; (setq cLayer (getvar "CLAYER")) ;;;;;;;;;;;; change depending on final offset method
; (princ cLayer)
;; get ent data tester: (entget (car (entsel)))
; processing selecton set
(if (not (ssget "_I"))
; if no currently active selection set:
(progn
(setq pt1 (getpoint "\nSpecify first corner: "))
(setq pt2 (getcorner pt1 "\nSpecify opposite corner: "))
(setq ss (ssget "_C"
pt1
pt2
)
)
)
; else there is an active (implied) selection set:
(progn
; get implied selection set
(setq ss (ssget "_I"))
; loop through selection set entities
(setq ssnum 0)
(setq pointList (list))
(repeat (sslength ss)
; get each entity
(setq entList (entget (ssname ss ssnum)))
; add list of x & y coords to list of points
(setq fullPt (assoc '10 entList))
(setq x (nth 1 fullPt))
(setq y (nth 2 fullPt))
(setq pointList (cons (list x y) pointList))
; increment indexing var
(setq ssnum (1+ ssnum))
)
)
)
; start joinSegments undo mark
(vla-startundomark doc)
; filter out anything that's not pline, line, or arc from ss before feeding to joinSegments
; then add those elements back into ss after joinSegments
(setq ssDelList (list))
(setq ssnum 0)
(repeat (sslength ss)
(setq eName (ssname ss ssnum))
(setq entList (entget eName))
(if (not
(wcmatch
(cdr (assoc '0 entList))
"LWPOLYLINE,LINE,ARC"
)
)
(setq ssDelList (cons eName ssDelList))
)
(setq ssnum (1+ ssnum))
)
(foreach eNameDel ssDelList
(ssdel eNameDel ss)
)
; join all unconnected entity groups into polylines
(princ ss)
(if ss
(joinSegments ss)
)
(princ ss)
(foreach eNameDel ssDelList
(ssadd eNameDel ss)
)
; end joinSegments undo mark
(vla-endundomark doc)
; update selection set - fix to work w/ implied set
; if implied selection set
(if (ssget "_I")
(princ "\nHERE!\n")
; else update previous crossing selection
(setq ss (ssget "_C" pt1 pt2))
)
; get list of all entities on points from previous list
; remove duplicates
; set ss as this list
; else:
; DEBUGGING - print length of selection set
; (princ
; (strcat "\nSSLENGTH: "
; (itoa (sslength ss))
; )
; )
; loop through entities in selection set
(setq ssnum 0)
(repeat (sslength ss)
; start individual offset undo mark
(vla-startundomark doc)
; Get entity name and assoc list for each entity
(setq ename (ssname ss 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)
; end individual offset undo mark
(vla-endundomark doc)
; increment ssnum
(setq ssnum (1+ ssnum))
)
; set all of selection set to "BYLAYER" styles
(setq ss (ssget "_C" pt1 pt2)) ; update ss
(setq setByLayerMode (getvar "SETBYLAYERMODE")) ; get SETBYLAYERMODE default
(setvar "SETBYLAYERMODE" 7) ; set color, linetype, lineweight to "BYLAYER"
(command-s "_.SETBYLAYER" ss "" "YES" "NO") ; set all entity styles to "BYLAYER", excluding blocks
; (note "._" ensures command works in non-English versions of ACAD and in case command was redefined)
(setvar "SETBYLAYERMODE" setByLayerMode) ; reset default
; turn CMDECHO back on if needed
(if (= (getvar "CMDECHO") 0)
(setvar "CMDECHO" cmdEcho)
)
; exit quietly
(princ)
)
;;; HELPER FUNCTIONS ;;;
; 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
)
(or
(equal
(cdr (assoc '0 entList))
"CIRCLE"
)
(equal
(cdr (assoc '0 entList))
"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)
)
; JOINSEGMENTS - joins groups of polylines, lines, arcs together into single polylines (works best if touching entity groups are on different layers)
(defun joinSegments (ss /)
; VARLIST
;; INPUTS
;;; ss - input selection set of any type (SEL SET)
;; LOCAL VARS - NONE
; join all segments into polylines
(setvar "PEDITACCEPT" 1)
; using PEDIT command to join all entity groups into polylines
(command-s "_.PEDIT" "MULTIPLE" ss "" "JOIN" "" "")
)
; last statement to display (quietly loading)
(princ)
script I'm using to load in a couple layers:
; command to load and save to defaults (if necessary) PV Vents/Misc Obstructions & PV Mech Obstructions
; could add support for customized display styles vs plot styles
; layerLoad - auto-loads "PV MECHANICAL OBSTRUCTIONS" and "PV VENTS SKYLIGHTS ROOF DRAINS OBSTRUCTIONS" layers
; turn off CMDECHO (stops commands from being printing to command line)
(setq cmdEcho (getvar "CMDECHO"))
(if (= cmdEcho 1) (setvar "CMDECHO" 0))
; load "PV Mechanical Obstructions"
(setq layername "PV Mechanical Obstructions")
(command "-LAYER" "N" layername "COLOR" "TRUECOLOR" "0,0,0" layername "LTYPE" "CONTINUOUS" layername "LWEIGHT" "DEFAULT" layername "TRANSPARENCY" "0" layername "")
; load "PV Misc Obstructions"
(setq layername "PV Misc Obstructions")
(command "-LAYER" "N" layername "COLOR" "TRUECOLOR" "0,0,0" layername "LTYPE" "CONTINUOUS" layername "LWEIGHT" "DEFAULT" layername "TRANSPARENCY" "0" layername "")
; release LAYERNAME from memory
(setq layername nil)
; set turn CMDECHO back on if needed
(if (= cmdEcho 0) (setvar "CMDECHO" 1))
; exit quietly
(princ)
