This code is the source code of a function in [AutoCAD Engineering Measurement Toolset] and can be run independently. Function drawing cross-section diagram ruler.
The code was first written in 1999 when the Gangwan Reservoir Survey Team was handling the survey industry. At that time, AutoCAD R14 was still used. More than 20 years later, I accidentally found it when I checked the network disk and ran it on AutoCAD 2018. , because the code is not professional and rigorous, there are some minor problems in some places, but overall the ruler can be drawn. If it is a program developed by VBA or C++, after so many years and version upgrades, the original program can hardly be loaded. From a purely compatibility perspective, LISP applet has a very strong vitality. At present and for many years to come, AutoCAD will continue to support LISP, so it is very ideal, practical and fast to use LISP to write some small tools in your work.
;;Draw cross-section elevation scale---------------------------------------- ------------------------------------------;;
(defun c:zzBC (/ i judge varBarPosition varOrigin varBarPosition_tmp varTextHeight
varBarPositionLevel varLength_tmp varLength varBarStartLevel varBarEndPositionLevel
varBarEndLevel varBarStartX varBarStartY varBarsCount varStartY varEndX varEndY
varPts)
(setq i 0)
(setq judge 0)
(grtext -1 "Draw ruler QinDong")
(princ "\\
")
(setq varOrigin (getpoint "Please enter something:"))
(princ "\\
")
(if (/= varLevel nil)
(progn (setq varLevel_tmp varLevel)
(setq PromptTmp
(strcat "elevation of this point" "<" (rtos varLevel 2 3) ">:"))
)
(setq PromptTmp "Height of this point:")
)
;;(while (<= (setq varLevel (getreal PromptTmp)) 0))
(if (= (setq varLevel (getreal PromptTmp)) nil)
(setq varLevel varLevel_tmp)
)
(princ "\\
")
(if (/= varBarPosition_tmp nil)
(setq PromptTmp (strcat "ruler distance"
"<"
(rtos (car varBarPosition_tmp) 2 3)
","
(rtos (cadr varBarPosition_tmp) 2 3)
">:"
)
)
(setq PromptTmp "Ruler distance:")
)
(princ "\\
")
(if (= (setq varBarPosition (getpoint PromptTmp)) nil)
(setq varBarPosition varBarPosition_tmp)
)
(setq varBarPosition_tmp varBarPosition)
;;Select the vertices of the ruler
(if (/= varLength_tmp nil)
(setq PromptTmp (strcat "ruler length"
"<"
(rtos (car varLength_tmp) 2 3)
","
(rtos (cadr varLength_tmp) 2 3)
">:"
)
)
(setq PromptTmp "Ruler length:")
)
(princ "\\
")
(if (= (setq varLength (getpoint PromptTmp)) nil)
(setq varLength varLength_tmp)
)
(setq varLength_tmp varLength)
(princ "\\
")
(if (/= varScale_tmp nil)
(setq
PromptTmp (strcat "scale denominator"
"<"
(rtos varScale_tmp 2 3)
">:")
)
(setq PromptTmp "Scale denominator:")
)
(if (= (setq varScale (getint PromptTmp)) nil)
(setq varScale varScale_tmp)
)
(if (and (/= nil varScale)
(/= nil varScale)
(/= nil varBarPosition)
(/= nil varLength)
(/= nil varOrigin)
)
;;if main
(progn
;;progn main
;;When determining the length of the ruler, click below to make corrections
(if (<= (cadr varLength) (cadr varBarPosition))
(setq varLength
(list (car varLength)
( + (cadr varBarPosition)
(abs (- (cadr varLength) (cadr varBarPosition)))
)
)
)
)
(setq varScale_tmp varScale)
(setq varScale (/varScale 100))
;;Length per cm in proportion
(setq varTextHeight (* (/varScale 10.0) 1.5))
;;Text height and width are 1.5mm
(EntMakeTextStyle
"LevelBar" varTextHeight 1 "simhei.ttf" "")
(EntMakeLayer "2-Section-Ruler" 1)
;;Determine the starting height of the ruler
(setq varBarPositionLevel
( + (- (cadr varBarPosition) (cadr varOrigin))
varLevel
)
)
(setq varBarStartLevel (fix ( + varBarPositionLevel 0.5)))
;;Round off to find the entire height of the starting point of the ruler
;;Determine the end elevation of the ruler
(setq varBarEndPositionLevel
( + (- (cadr varLength) (cadr varOrigin))
varLevel
)
)
(setq varBarEndLevel (fix ( + varBarEndPositionLevel 0.5)))
;;Round off to find the entire height of the starting point of the ruler
;;Determine the coordinates of the starting point of the ruler
(setq varBarStartX (car varBarPosition))
(setq varBarStartY
( + (cadr varBarPosition)
(- varBarStartLevel varBarPositionLevel)
)
)
(setq varBarsCount
( + (atoi
(rtos
(/ (- varBarEndLevel varBarStartLevel) varScale)
\t\t 2
0
)
)
\t\t1
)
)
(setq varBarsCount (* (fix ( + (/ varBarsCount 2) 0.5)) 2))
(while (/= varBarsCount 0)
(setq varStartY ( + varBarStartY (* i varScale)))
(setq varEndX (- varBarStartX (* (/varScale 10.0) 1.5)))
(setq varEndY ( + varBarStartY (* ( + i 1) varScale)))
(setq Fp (list varBarStartX varStartY))
(setq Ep (list varEndX varEndY))
(setq Lfp (list varBarStartX varStartY))
(setq Lep
(list ( + varBarStartX (/varScale 10.0)) varStartY))
(setq
Txtp
(list ( + varBarStartX (* (/varScale 10.0) 2.0)) varEndY)
)
(setq Hi ( + varBarStartLevel (* varScale i)))
(setq
Loe (list ( + (/varScale 10.0) varBarStartX)
varBarStartY)
)
(if (= judge 0)
(progn
(setq SolidBarFp
(list (/ ( + (car Fp) (car Ep)) 2) (cadr Fp))
)
;;Start point of solid ruler
(setq SolidBarEp
(list (/ ( + (car Fp) (car Ep)) 2) (cadr Ep))
)
;;Solid ruler end point
(entMakePLineThick
(list SolidBarFp SolidBarEp)
varTextHeight
"2-Section-Ruler"
)
(EntMakeLine
(car lfp)
(cadr Lfp)
(car Lep)
(cadr Lep)
"2-Section-Ruler"
)
(EntMakeText
( + varBarStartX (* (/varScale 10.0) 1.1))
varStartY
(itoa Hi)
varTextHeight
"LevelBar"
"2-Section-Ruler"
)
(setq judge 1)
)
(progn
(setq varPts nil)
(setq varPts
(cons (list varBarStartX varStartY) varPts))
(setq
varPts (cons (list varBarStartX varEndY) varPts))
(setq varPts (cons (list varEndX varEndY) varPts))
(setq varPts (cons (list varEndX varStartY) varPts))
(entMakePLine varPts "2-section-ruler")
(setq judge 0)
)
)
(setq i ( + i 1))
(setq varBarsCount (- varBarsCount 1))
)
(if (= judge 0)
(progn
(setq Lfp (list varBarStartX varEndY))
(setq Lep
(list ( + varBarStartX (/varScale 10.0)) varEndY))
(setq Hi ( + varBarStartLevel (* varScale i)))
(EntMakeLine
(car lfp)
(cadr Lfp)
(car Lep)
(cadr Lep)
"2-Section-Ruler"
)
(EntMakeText
( + varBarStartX (* (/varScale 10.0) 1.1))
varEndY
(itoa Hi)
varTextHeight
"LevelBar"
"2-Section-Ruler"
)
)
)
(princ
"\\
(C) Surveying Team of Ninghai Construction Bureau of the 12th Hydropower Bureau QinDong [email protected]"
)
(vl-cmdf "regen")
(princ)
)
;;end progn main
(progn
(princ
"\\
Input error! Please follow the prompts! (C) Surveying Team of Ninghai Construction Bureau of the 12th Hydropower Bureau QinDong [email protected]"
)
(princ)
)
)
;;end if main
)
;;Draw cross-section elevation scale