; Linear Interpolation in a Horizontal plan
; Based on: http://www.autocadproblems.com/2014/09/marking-level-on-plan-autocad.html
; Slightly modified by Igal Averbuh 2017
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun c:hi()

(princ "\nNeed to disable WinHEB in order to work with this program\n")
(defun LayerPurgePrevention (dictName layerNameList / layerEnameList)
(dictremove (namedobjdict) dictName)
(if
(setq layerEnameList
(vl-remove
nil
(mapcar
'(lambda (layerName) (tblobjname "layer" layerName))
layerNameList
)
)
)
(dictadd
(namedobjdict)
dictName
(entmakex
(vl-list*
'(0 . "XRECORD")
'(100 . "AcDbXrecord")
(mapcar
'(lambda (layerEname) (cons 340 layerEname))
layerEnameList
)
)
)
)
)
)
(setvar "cmdecho" 0)
(command "-layer" "m" "000-Interpolate Text Labels" "")

(LayerPurgePrevention "OnsBedrijfLayerPurgePrevention" '("000-Interpolate Text Labels"))

(command "-style" "Igal" "Arial.ttf" "0" "" "" "" "")

(setvar 'textsize
(cond ((getdist (strcat "\nSpecify Text Height : ")))
((getvar 'textsize))
)
)

(while (not
(setq GL1 (entsel "\nSelect First Boundary Text Value:"))
))
(setq Lvl1 (entget (car GL1)))

(if (> (length Lvl1) 22)
(setq G_val1 (nth 13 Lvl1))

(setq G_Val1 (nth 11 Lvl1))
)

(while (not
(setq GL2 (entsel "\nSelect Second Boundary Text Value:"))
))
(setq Lvl2 (entget (car GL2)))

(if (> (length Lvl2) 22)
(setq G_val2 (nth 13 Lvl2))

(setq G_Val2 (nth 11 Lvl2))
)

(setq p1 (getpoint "Pick Point Range From:"))
(setq d (getdist p1 "Pick Point Range To:"))
(setq d (float d))

(setq slp1 (- (atof(cdr G_val2)) (atof(cdr G_val1))))
(setq slp (/ slp1 d))

(while
(setq Txt_Pnt (getpoint "\nPick on Interpolate Point in Range..:"))
(setq d1 (distance p1 Txt_pnt))
(setq new_lvl (+ (atof(cdr G_val1)) (* d1 slp)))
(setq val1 (rtos new_lvl 2 3))
(command "text" Txt_pnt "" "" val1)
)
)
(c:hi)

Advertisements