;----------------------------------------------------------------------------
; PLWIDTH.LSP CHANGE WIDTH OF POLYLINES
;============================================================================
;DESCRIPTION: This routine will globally change the width of all selected
; polylines to a user supplied width.
; Select polylines using Select, Window or Crossing. The routine
; will filter out and act only on 2D polylines contained within the
; selection set.
;
;WRITTEN BY: Alan Cullen 1993
; McPherson Maclean Wargon Chapman - CAIRNS
;
;AMENDED: 7-8-95 Error Handler included. One pass width change.
;
;START COMMAND: plw
;
;;-------------------------Error Handler--------------------------------------
(defun clerr (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setq a nil)
(command "U")
(command "_.UNDO" "_E")
(if olderr (setq *error* olderr))
(princ)
)
;;-----------------------Main Program------------------------------------------
(defun c:plw (/ olderr a n index b1 b c d b2 width b3)
(setq olderr *error* *error* clerr) ;;; Set new error handler
(command "_.UNDO" "_GROUP")
(prompt "\n GLOBALLY CHANGE WIDTH OF SELECTED POLYLINES - August 1995 - Alan CULLEN")
(setq width (getreal "\nEnter required width for all polylines:.. "))
(prompt "\nThis routine will filter out and only act on polylines in the selection set...")
(setq a (ssget
'((0 . "LWPOLYLINE")))
)
(setq n (sslength a))
(setq index 0)
(repeat n
(setq b1 (entget (ssname a index)))
(setq index (+ 1 index))
(setq c (assoc 43 b1))
(setq d (cons (car c) width))
(setq b2 (subst d c b1))
; (setq c (assoc 41 b1 ))
; (setq d (cons (car c) width))
; (setq b3 (subst d c b2))
(entmod b2)
)
(setq a nil)
(command "_.UNDO" "_E")
(setq *error* olderr)
(princ)
(princ)
)

Advertisements