Author Topic: Draw Foundation Routine  (Read 3760 times)

0 Members and 1 Guest are viewing this topic.

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
Draw Foundation Routine
« on: July 30, 2004, 01:46:54 PM »
Kate you may be intersted in this foundation routine.
It could use some work though.
Code: [Select]
;;;              FooterOffset.lsp
;;;         Created by C. Alan Butler  2004
;;;
;;;    Draw a poly line and then offset it & erase the original
;;;    Trace points along one side of the foundation wall
;;
;;;   THIS SOFTWARE IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED
;;;   WARRANTY.  ALL IMPLIED WARRANTIES OF FITNESS FOR ANY PARTICULAR
;;;   PURPOSE AND OF MERCHANTABILITY ARE HEREBY DISCLAIMED.
;;;
;; error function & Routine Exit
(defun *error* (msg)
  (if (not (member msg
        '("console break" "Function cancelled" "quit / exit abort")
      )
    )
     (princ (strcat "\nError: " msg))
  ) ; if
  (princ)
) ;end error function
;;
;;  pre set global variable, it remember your entry
;;  FtrWidth WallWidth
;;======================
;;    Start of Routine
;;======================
(defun C:FtrOffset (/ pt1 pt2 pto usercmd useros str en1 tmp ShortOfs LongOfs)
;;; -------  Some Housekeeping   ------------------
  (setq usercmd (getvar "CMDECHO"))
  (setvar "CMDECHO" 0)
  (setvar "PLINEWID" 0)
  (setq useros (getvar "osmode")
        str "")
  (setvar "osmode" 175); my favorite
  (if (null FtrWidth)
    (setq FtrWidth 24); Global variable, do not declare
  )
  (if (null WallWidth)
    (setq WallWidth 8); Global variable, do not declare
  )
  ;;=======================================
  (setq tmp (getreal (strcat "Enter the Footer width : <" (rtos FtrWidth 2 2)">")))
  (if (> tmp 1);could use some error checking
    (setq FtrWidth tmp)
  )
  (setq tmp (getreal (strcat "Enter the Foundation Wall width : <" (rtos WallWidth 2 2)">")))
  (if (> tmp 1);could use some error checking
    (setq WallWidth tmp)
  )
  (setq ShortOfs (/ (- FtrWidth WallWidth) 2.0))
  (setq LongOfs (+ ShortOfs WallWidth))
  (command "undo" "begin")
  (prompt "/nPick points along wall, Enter when done.")
  ;;; Draw the pline
  (setq pt1 (getpoint))
  (command "PLINE" pt1 (Setq pt2 (getpoint pt1))) ;_ COMMAND
  (while (setq pt2 (getpoint pt2 "\nNext point: "))(command pt2)) ;_ WHILE
  (command "")
  (princ)
  (setq en1 (entlast))
  (setvar "osmode" 0)
  (initget 1)
  (setq pto (getpoint "\nPick Side closest to footer edge:"))
  (command "_.offset" ShortOfs en1 pto "")
  (setq pto (getpoint "\nPick Opposite Side footer:"))
  (command "_.offset" LongOfs en1 pto "")
  (entdel en1) ; remove the user drawn line
  (command "undo" "end")
;;;==========  Exit Sequence  ============
  (setvar "osmode" useros)
  (setvar "CMDECHO" usercmd)
  (princ); Exit quietly
) ;_end of defun
;;; Notify user program ready to use
(prompt "\n Footer Offsest Loaded:   Type 'FtrOffset' to run it.")
(princ)
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.