Message 1 of 2
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Here's script I'm using to offset various polylines. The custom *error* function (inside the offsetOuter helper function) is to handle cases where the offset initially tries to go inside the polyline, but is too small (throwing an error). The issue is, for any selection set with at least 1 such polyline, only 1 polyline gets offset. How might I fix this? Does the *error* function quit the current application? How do I get the program to keep running after the *error* function goes?
(defun c:OFFSETAUTO (/ ) ;;;;;; add all local vars
; get CMDECHO var current state, set to off if on then setback to off ;;;;;;;;;
; make (command) (command-s), and fix commands to have _. in front when/if necessary
; add in undo blocks
; offset vars
(setq circOffset 4) ; 4 inch offset (circle)
(setq circOSLayer "PV VENTS SKYLIGHTS ROOF DRAINS") ; layer of offset (circle)
(setq circOSColor 5) ; offset color index (circle)
(setq osLWeight "BYLAYER") ; offset lineweight
(setq osLType "BYLAYER") ; offset linetype
; 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)
; change to specified color, lineweight, linetype ;;;;; change depending on final offset method
; (command "COLOR" circOSColor)
; (command "LWEIGHT" osLWeight)
; (command "LINETYPE" "SET" osLType "")
(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 selection set:
(setq ss (ssget "_I"))
)
; join all unconnected entity groups into polylines
(joinSegments ss)
; after segments are joined, the entities in the original selection set have changed, so the selection set must be modified to include the changes
(setq ss (ssget "_C" pt1 pt2))
; DEBUGGING - print length of selection set
; (princ
; (strcat "\nSSLENGTH: "
; (itoa (sslength ss))
; )
; )
; loop through entities in selection set
(setq ssnum 0)
(repeat (sslength ss)
; 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 "\n")
; (princ "Entity:\n")
; (princ entList)
; if entity is on "PV Misc Obstructions" layer and is a CIRCLE
(if
(and
(equal
(cdr (assoc '8 entList))
"PV Misc Obstructions"
)
(equal
(cdr (assoc '0 entList))
"CIRCLE"
)
)
; then offset circle
(offsetCircle entList circOffset circOSColor circOSLayer)
; else if "PV Misc Obstructions" layer and entity is LWPOLYLINE
(if
(and
(equal
(cdr (assoc '8 entList))
"PV Misc Obstructions"
)
(equal
(cdr (assoc '0 entList))
"LWPOLYLINE"
)
)
(offsetOuter ename circOffset circOSColor circOSLayer)
)
;; vla-offset tester: (vla-offset (vlax-ename->vla-object (car (entsel))) 4)
;; get ent data tester: (entget (car (entsel)))
;; to fix the offset inner/outer issue, could make offset then compare area of offset and original ent
)
; if mech obstruction
; increment ssnum
(setq ssnum (1+ ssnum))
)
; exit quietly
(princ)
)
;;; HELPER FUNCTIONS ;;;
;
(defun offsetOuter (ename osDist osColor osLayer / *error* originalArea offsetEName offsetArea offsetEList)
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(progn
(vla-offset (vlax-ename->vla-object ename) (- osDist))
; get new offset assic list
(setq offsetEList (entget (entlast)))
; change offset color
(setq offsetEList (append
(vl-remove (assoc '420 offsetEList)
offsetEList
)
(list (cons '62 osColor))
)
)
(entmod offsetEList)
; change offset color
(setq offsetEList (subst (cons '8 osLayer)
(assoc '8 offsetEList)
offsetEList
)
)
(entmod offsetEList)
)
)
(princ)
)
; 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)
; error handling if vla-offset attempts to inner-offset an entity too small (offset wouldn't fit inside entity)
; 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 assic list
(setq offsetEList (entget (entlast)))
; change offset color
(setq offsetEList (append
(vl-remove (assoc '420 offsetEList)
offsetEList
)
(list (cons '62 osColor))
)
)
(entmod offsetEList)
; change offset color
(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 "PEDIT" "MULTIPLE" ss "" "JOIN" "" "")
; NEED to add error handling if all entities in selection set are already joined
)
; OFFSETCIRCLE - offsets given circle by given amount and on given layer & color, returns assoc list of final offset entity
(defun offsetCircle (entList circOffset circOSColor circOSLayer / offsetEList)
; VARLIST
;; INPUTS
;;; entList - entity definition of given circle (ASSOC LIST)
;;; circOffset - amount to offset circle by (INT)
;;; circOSColor - circle offset color (INT) ;;;;; NOT CURRENTLY IN USE
;;; circOSLayer - circle offset layer (STR)
;; LOCAL VARS
;;; offsetEList - offset entity definition (ASSOC LIST)
; create circular offset
(vla-offset (vlax-ename->vla-object (cdr (car entList))) circOffset)
; change offset color
(setq offsetEList (entget (entlast)))
(setq offsetEList (append
(vl-remove (assoc '420 offsetEList)
offsetEList
)
(list (cons '62 circOSColor))
)
)
(entmod offsetEList)
; change offset layer
(setq offsetEList (subst (cons '8 circOSLayer)
(assoc '8 offsetEList)
offsetEList
)
)
(entmod offsetEList)
)
; GETRAD - returns radius of circle entity
(defun getRad (entList /)
; VARLIST
;; INPUTS
;;; entList - entity definition to extract radius from (ASSOC LIST)
;; LOCAL VARS - NONE
(cdr (assoc '40 entList))
)
; MODIFYENT - returns modified entity list, based on given new dotted pair
(defun modifyEnt (entList newDPair / cDXFcode cPair)
; VARLIST
;; INPUTS
;;; entList - entity definition to modify (ASSOC LIST)
;;; newDPair - new information to swap into entList (DOTTED PAIR)
;; LOCAL VARS
;;; cDXFcode - DXF group code of current and new dotted pair (INT)
;;; cPair - current dotted pair in entity assoc list to modify (DOTTED PAIR)
(setq cDXFcode (car newDPair))
(setq cPair (assoc cDXFcode entList))
(subst newDPair cPair entList)
)
; GETCOORD - returns x or y coordinate of entity
(defun getCoord (coordName entList /)
; VARLIST
;; INPUTS
;;; coordName - name of coordinate to get, x or y (STR)
;;; entList - entity definition to extract coordinate from (ASSOC LIST)
;; LOCAL VARS - NONE
; coordName error handling
; (princ "\nequal to x?\n")
; (princ (equal (strcase coordName T) "x"))
(if
(and
(not (equal (strcase coordName T) "x"))
(not (equal (strcase coordName T) "y"))
)
(progn
(princ "\n; error: malformed coordName (Function GETCOORD)\n")
(quit)
)
; if coordName is "x" or "y" continue
(if (equal (strcase coordName T) "x")
; if x coord:
(float
(nth 1
(assoc '10 entList)
)
)
; else y coord:
(float
(nth 2
(assoc '10 entList)
)
)
)
)
)
; last statement to display (quietly loading)
(princ)
Apologies for the unclear comments in some cases, the script isn't done yet
Solved! Go to Solution.
