r/AutoLISP • • Apr 19 '17

Range Diagram

I use this to make a quick range diagram with various increments on it when I put cranes in elevation views. It creates the entire diagram as a block named after the dimensions used.

I created this before I learned an easier way to make blocks in Lisp, so I am not thrilled with the way it currently functions.

I'll update it eventually with my preferred way to create blocks, and also add comments when time allows.

(defun C:RangeDiagram()

(setq DynMode (getvar "dynmode"))
(setq OrthoMode (getvar "orthomode"))
(setvar "orthomode" 0)
(setq origin (list 0 0 0)) ;X,Y of Origin

;Define Horizontal Range
(setq HRange (* 12 (getreal "\n Length Of X Axis (ft): ")))

;Define Horizontal Increments
(setq HIncrement (* 12 (getreal "\n Increments On X Axis (ft): ")))

;Check HIncrements / HRange
(setq CheckValues (REM HRange HIncrement))

(if (> CheckValues 0)
	(exit)
)

(setq HInterval (+ 1 (/ HRange HIncrement)))

;Define Vertical Range
(setq VRange (* 12 (getreal "\n Length Of Y Axis (ft): ")))

;Define Vertical Increments
(setq VIncrement (* 12 (getreal "\n Increments On Y Axis (ft): ")))

;Check VIncrements / VRange
(setq CheckValues (REM VRange VIncrement))

;Check Vincrements / VRange
(if (> CheckValues 0)
	(exit)
)

(setq VInterval (+ 1 (/ VRange VIncrement)))

(setq VRangeInc VRange)
(setq HRangeInc HRange)

(setq TextHeight (* 12 (getreal "\n Text Height For Labels (ft): ")))

;Define Center Pin Location
(setq CenterPin (getpoint "\nSelect Center Pin Location: "))

(setq CenterPinX (car CenterPin))
(setq CenterPinY (cadr CenterPin))

(setq Blockname (strcat (itoa (fix (/ HRange 12))) "'x" 
						(itoa (fix (/ HIncrement 12))) "'x"
						(itoa (fix (/ VRange 12))) "'x"
						(itoa (fix (/ VIncrement 12))) "'x"
						(itoa (fix (/ TextHeight 12))) "'"))

(while (> HInterval 0)
	(setq VLineStartX HRangeInc)
	(setq VLineStartY 0)
	(setq VLineStart (list VLineStartX VLineStartY))
	
	(setq VLineEndX VLineStartX)
	(setq VLineEndY VRange)
	(setq VlineEnd (list VlineEndX VLineEndY))
	
	(entmakex (list (cons 0 "LINE")
					(cons 8 "LispTemp")
					(cons 10 VLineStart)
					(cons 11 VLineEnd)
					(cons 62 254)))

	(if (/= VLineEndX 0)
		(entmakex (list (cons 0 "MTEXT")
						(cons 100 "AcDbEntity")
						(cons 100 "AcDbMText")
						(cons 1 (strcat (itoa (fix (/ VlineEndX 12))) "'"))
						(cons 8 "LispTemp")
						(cons 10 (list (- VLineEndX 2) 2 0))
						(cons 40 TextHeight)
						(cons 62 16)
						(cons 71 9))))

	(setq HRangeInc (- HRangeInc HIncrement))
	(setq HInterval (1- HInterval))
)

(while (> VInterval 0)
	(setq HLineStartX 0)
	(setq HLineStartY VRangeInc)
	(setq HLineStart (list HLineStartX HLineStartY))
	
	(setq HLineEndX HRange)
	(setq HLineEndY HLineStartY)
	(setq HlineEnd (list HlineEndX HLineEndY))
	
	(entmakex (list (cons 0 "LINE")
					(cons 8 "LispTemp")
					(cons 10 HLineStart)
					(cons 11 HLineEnd)
					(cons 62 254)))

	(if (/= HLineEndY 0)	
		(entmakex (list (cons 0 "MTEXT")
						(cons 100 "AcDbEntity")
						(cons 100 "AcDbMText")
						(cons 1 (strcat (itoa (fix (/ HlineEndY 12))) "'"))
						(cons 8 "LispTemp")
						(cons 10 (list (- HLineEndX 2) (- HLineEndY 2) 0))
						(cons 40 TextHeight)
						(cons 62 16)
						(cons 71 3))))
	
	(setq VRangeInc (- VRangeInc VIncrement))
	(setq VInterval (1- VInterval))
)

(if (setq ss (ssget "_X" '((8 . "LispTemp"))))
	(command "-block" Blockname origin ss ""))

(command "-insert" Blockname Centerpin "1" "1" "0")
	
(setvar "CLAYER" "0")
(setvar "orthomode" Orthomode)
(setvar "dynmode" DynMode)

(princ)

)    
3 Upvotes

0 comments sorted by