(defun make_blk_measure ( / )
(if (not (tblsearch "STYLE" "$BLK_MEAS"))
(entmake '((0 . "STYLE")
(5 . "40")
(100 . "AcDbSymbolTableRecord")
(100 . "AcDbTextStyleTableRecord")
(2 . "$BLK_MEAS")
(70 . 0)
(40 . 0.0)
(41 . 0.7)
(50 . 0.0)
(71 . 0)
(42 . 0.1)
(3 . "ARIAL.TTF")
(4 . "")
)
)
)
(if (not (tblsearch "BLOCK" "BLK_MEASURE_CURVE"))
(progn
(entmake
'((0 . "BLOCK") (8 . "0") (2 . "BLK_MEASURE_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0))
)
(entmake
(append
'((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine"))
(list (list 10 0.0 (- (getvar "TEXTSIZE")) 0.0))
(list (list 11 0.0 (getvar "TEXTSIZE") 0.0))
'((210 0.0 0.0 1.0))
)
)
(entmake
'(
(0 . "ATTDEF")
(100 . "AcDbEntity")
(67 . 0)
(410 . "Model")
(8 . "0")
(62 . 0)
(6 . "ByBlock")
(370 . -2)
(100 . "AcDbText")
(10 0.0 0.0 0.0)
(40 . 1.0)
(1 . "0.0")
(50 . 1.570796326794896)
(41 . 0.7)
(51 . 0.0)
(7 . "$BLK_MEAS")
(71 .
(72 . 1)
(11 1.0 0.0 0.0)
(210 0.0 0.0 1.0)
(100 . "AcDbAttributeDefinition")
(3 . "measure")
(2 . "VALUE_MEASURE")
(70 . 0)
(73 . 0)
(74 . 1)
)
)
(entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2)))
)
)
(if (not (tblsearch "BLOCK" "BLK_TICK_CURVE"))
(progn
(entmake
'((0 . "BLOCK") (8 . "0") (2 . "BLK_TICK_CURVE") (70 . 2) (4 . "") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (10 0.0 0.0 0.0))
)
(entmake
(append
'((0 . "LINE") (100 . "AcDbEntity") (67 . 0) (410 . "Model") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2) (100 . "AcDbLine"))
(list (list 10 0.0 (* 0.5 (- (getvar "TEXTSIZE"))) 0.0))
(list (list 11 0.0 (* 0.5 (getvar "TEXTSIZE")) 0.0))
'((210 0.0 0.0 1.0))
)
)
(entmake '((0 . "ENDBLK") (8 . "0") (8 . "0") (62 . 0) (6 . "ByBlock") (370 . -2)))
)
)
)
(defun z_dir (p1 p2 / )
(trans
'(0.0 1.0 0.0)
(mapcar
'(lambda (k)
(/ k
(sqrt
(apply '+
(mapcar
'(lambda (x) (* x x))
(mapcar '- p2 p1)
)
)
)
)
)
(mapcar '- p2 p1)
)
0
)
)
(defun c:chainage ( / js dxf_obj obj_vlax pt_start pt_end total_dist partial_dist ori_dist tmp_var lst_pt increment_dist sv_luprec sv_dzin ang dxf_210 p_fix mantiss count)
(princ "\nChoose a curvilinear object to be measured: ")
(while
(not
(setq js
(ssget "_+.:E:S"
(list
(cons 0 "*POLYLINE,LINE,ARC,CIRCLE,ELLIPSE,SPLINE")
(cons 67 (if (eq (getvar "CVPORT") 2) 0 1))
(cons 410 (if (eq (getvar "CVPORT") 2) "Model" (getvar "CTAB")))
(cons -4 "<NOT")
(cons -4 "&") (cons 70 112)
(cons -4 "NOT>")
)
)
)
)
(princ "\nIt is not a valid curvilinear object for this function!")
)
(vl-load-com)
(setq
dxf_obj (entget (ssname js 0))
obj_vlax (vlax-ename->vla-object (ssname js 0))
pt_start (vlax-curve-getStartPoint obj_vlax)
pt_end (vlax-curve-getEndPoint obj_vlax)
total_dist (vlax-curve-getDistAtParam obj_vlax (vlax-curve-getEndParam obj_vlax))
partial_dist (getreal "\nTo establish the chainage with a distance of? <1000.0>: ")
)
(if (not partial_dist) (setq partial_dist 500.0) (setq partial_dist (* 0.5 partial_dist)))
(setq ori_dist (getreal "\nStart chainage at (give décimal value) 0+000 <0.0>: "))
(if (not ori_dist) (setq ori_dist 0.0))
(cond
((> total_dist partial_dist)
(initget 6)
(setq tmp_var (getdist (strcat "\nEnter a new value for pour TEXTSIZE <" (rtos (getvar "TEXTSIZE")) ">: ")))
(if (not tmp_var) (setq tmp_var (getvar "TEXTSIZE")))
(setvar "TEXTSIZE" tmp_var)
(make_blk_measure)
(setq
sv_luprec (getvar "LUPREC")
sv_dzin (getvar "DIMZIN")
)
(setvar "DIMZIN" 0)
(setq count 1)
(setq increment_dist (rem (- 1000.0 (atoi (substr (rtos ori_dist 2 3) (+ 2 (vl-string-search "." (rtos ori_dist 2 3)))))) partial_dist))
(setvar "CMDECHO" 1)
(setvar "LUPREC" 0)
(while (< increment_dist total_dist)
(setq
lst_pt (cons (vlax-curve-getPointAtDist obj_vlax increment_dist) lst_pt)
increment_dist (+ increment_dist partial_dist)
)
)
(setq lst_pt (reverse (cons pt_end lst_pt)))
(foreach n lst_pt
(setq
ang (angle '(0.0 0.0 0.0) (vlax-curve-getFirstDeriv obj_vlax (vlax-curve-getParamAtPoint obj_vlax n)))
dxf_210 (z_dir n (polar n ang (* 0.1 partial_dist)))
p_fix (atoi (rtos (/ (vlax-curve-getDistAtPoint obj_vlax n) 1000.0) 2 3))
mantiss
(+
(-
(vlax-curve-getDistAtPoint obj_vlax n)
(* p_fix 1000.0)
)
(atoi (substr (rtos ori_dist 2 3) (+ 2 (vl-string-search "." (rtos ori_dist 2 3)))))
)
)
(if (or (equal mantiss 1000.0 1E-3) (> mantiss 1000.0)) (setq p_fix (1+ p_fix) mantiss (- mantiss 1000)))
(if (zerop (fix mantiss))
(setq mantiss "000")
(if (eq (strlen (itoa (fix (+ mantiss 0.1)))) 2)
(setq mantiss (strcat "0" (rtos (fix (+ mantiss 0.001)) 2 0)))
(setq mantiss (rtos mantiss 2 0))
)
)
(cond
((zerop (rem (setq count (1+ count)) 2))
(entmake
(list
(cons 0 "INSERT")
(cons 100 "AcDbEntity")
(assoc 67 dxf_obj)
(assoc 410 dxf_obj)
(cons 8 (getvar "CLAYER"))
(cons 100 "AcDbBlockReference")
(cons 66 1)
(cons 2 "BLK_MEASURE_CURVE")
(cons 10 (trans n 0 dxf_210))
(cons 41 (* 0.1 partial_dist))
(cons 42 (* 0.1 partial_dist))
(cons 43 (* 0.1 partial_dist))
(cons 50 ang)
(cons 210 dxf_210)
)
)
(entmake
(list
(cons 0 "ATTRIB")
(cons 100 "AcDbEntity")
(assoc 67 dxf_obj)
(assoc 410 dxf_obj)
(cons 8 (getvar "CLAYER"))
(cons 100 "AcDbText")
(cons 10 (trans '(0 0 0) 0 dxf_210))
(cons 40 (getvar "TEXTSIZE"))
(cons 1
(strcat
(itoa (+ p_fix (fix ori_dist)))
"+"
mantiss
)
)
(cons 50 (+ (/ pi 2) ang))
(cons 41 0.7)
(cons 51 0.0)
(cons 7 "$BLK_MEAS")
(cons 71 0)
(cons 72 1)
(cons 11 (trans n 0 dxf_210))
(cons 210 dxf_210)
(cons 100 "AcDbAttribute")
(cons 2 "VALUE_MEASURE")
(cons 70 0)
(cons 73 0)
(cons 74 1)
)
)
(entmake (list (cons 0 "SEQEND") (cons 8 (getvar "CLAYER")) (cons 62 0) (cons 6 "ByBlock") (cons 370 -2)))
)
(T
(entmake
(list
(cons 0 "INSERT")
(cons 100 "AcDbEntity")
(assoc 67 dxf_obj)
(assoc 410 dxf_obj)
(cons 8 (getvar "CLAYER"))
(cons 100 "AcDbBlockReference")
(cons 2 "BLK_TICK_CURVE")
(cons 10 (trans n 0 dxf_210))
(cons 41 (* 0.1 partial_dist))
(cons 42 (* 0.1 partial_dist))
(cons 43 (* 0.1 partial_dist))
(cons 50 ang)
(cons 210 dxf_210)
)
)
)
)
)
(setvar "LUPREC" sv_luprec)
(setvar "DIMZIN" sv_dzin)
)
(T (princ "\nThe length is too big for the object!"))
)
(prin1)
)