AfraLisp Blog

The AutoLisp/Visual Lisp/VBA Resource Website

AfraLisp Blog

Home Newsletter Utter Rubbish Coding Tips AutoCAD Tips Contact Downloads WAUN

And, something from Russell Johnston

; EXTREME.lsp
; Finds the extreme upper right corner of a selection set of LINES only

; Written By : R. Johnston
; Date : Feb 18/02

;--------------------------------------------------------------------------

(prompt "\nType EXTR to run")
(print)

; Error Function

(defun *error* (msg)
(print msg)
(command ".undo" "back")
(setq *error* OLDERROR)
(setvar "cmdecho" OLDCMDECHO)
(setvar "cmddia" OLDCMDDIA)
(setvar "filedia" OLDFILEDIA)
)

; Start Main Function

(defun c:EXTR (/ N)

; Store original system variables

(setq OLDERROR *error*)
(setq OLDCMDECHO (getvar "cmdecho"))
(setq OLDCMDDIA (getvar "cmddia"))
(setq OLDFILEDIA (getvar "filedia"))
(setq OLDOSMODE (getvar "osmode"))

; Set system varibales to 0

(setvar "cmdecho" 1)
(setvar "cmddia" 0)
(setvar "filedia" 0)
(setvar "osmode" 0)

; Main Program

(command ".undo" "mark") ;set point to undo to if an error occurs

(setq SS (ssget))

(setq SSLENG (sslength SS))

(setq TEXT1 (strcat "Number of Entities = " (itoa SSLENG)))

(princ TEXT1)

(setq N 0)

(setq XVALUES (list 0))

(setq YVALUES (list 0))

(repeat SSLENG

(setq EN (ssname SS N))

(setq EL (entget EN))

(setq XPT1 (list (car (cdr (assoc 10 EL)))))

(setq XPT2 (list (car (cdr (assoc 11 EL)))))

(setq YPT1 (list (cadr (cdr (assoc 10 EL)))))

(setq YPT2 (list (cadr (cdr (assoc 11 EL)))))

(setq XVALUES (append XVALUES XPT1 XPT2))

(setq YVALUES (append YVALUES YPT1 YPT2))

(setq N (+ N 1))

);End of repeat bracket

(print XVALUES)

(print YVALUES)

; Find Maximum X value

(setq MAXXPT 0)

(setq N1 0)

(repeat (length XVALUES)

(if (> (nth N1 XVALUES) MAXXPT) (setq MAXXPT (nth N1 XVALUES)) ())

(setq N1 (+ N1 1))

);End of repeat bracket

(print MAXXPT)

; Find Maximum Y value

(setq MAXYPT 0)

(setq N2 0)

(repeat (length YVALUES)

(if (> (nth N2 YVALUES) MAXYPT) (setq MAXYPT (nth N2 YVALUES)) ())

(setq N2 (+ N2 1))

);End of repeat bracket

(print MAXYPT)

; Create Upper Right Point

(setq MAXPT (list MAXXPT MAXYPT))

(command ".circle" MAXPT "1")

; Set system variables back to original values

(setvar "cmdecho" OLDCMDECHO)
(setvar "cmddia" OLDCMDDIA)
(setvar "filedia" OLDFILEDIA)
(setvar "osmode" OLDOSMODE)

(princ)
)
; End Main Function

The AutoLisp/Visual Lisp/VBA Resource Website

Copyright © 1999-Perpetuity by AfraLisp

All rights reserved.
Information in this document is subject to change without notice.
Site created and maintained by Kenny Ramage

The AutoLisp/Visual Lisp/VBA Resource Website