Customizing azimuth/distance display for automated survey plats
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
Please I have the code below which I have been using for several years. I got the code from this forum and after some modifications it has served me just fine. The code is:
(vl-load-com)
(defun c:brg69 ( / l_var js htx AcDoc Space ss nw_style n obj ename pr dist_start dist_end pt_start pt_end seg_len alpha val_txt dim_txt nw_obj)
(setq l_var (mapcar 'getvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS")))
(mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") '(1 2 2 2))
(princ "\nSelect polylines or lines.")
(while (null (setq js (ssget '((0 . "LWPOLYLINE,LINE")))))
(princ "\nSelection is empty or not are LWPOLYLINE,LINE!")
)
(initget 6)
(setq htx (getdist (getvar "VIEWCTR") (strcat "\nSpecify text height <" (rtos (getvar "TEXTSIZE")) ">: ")))
(if htx (setvar "TEXTSIZE" htx))
(setq
AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
Space
(if (= 1 (getvar "CVPORT"))
(vla-get-PaperSpace AcDoc)
(vla-get-ModelSpace AcDoc)
)
ss (ssadd)
)
(vla-startundomark AcDoc)
(cond
((null (tblsearch "LAYER" "DIMENSIONS"))
(vlax-put (vla-add (vla-get-layers AcDoc) "DIMENSIONS") 'color 7)
)
)
(cond
((null (tblsearch "STYLE" "LABEL_ARIAL"))
(setq nw_style (vla-add (vla-get-textstyles AcDoc) "LABEL_ARIAL"))
(mapcar
'(lambda (pr val)
(vlax-put nw_style pr val)
)
(list 'FontFile 'Height 'ObliqueAngle 'Width 'TextGenerationFlag)
(list (strcat (getenv "windir") "\\fonts\\arial.ttf") 0.0 0.0 1.0 0.0)
)
)
)
(repeat (setq n (sslength js))
(setq
obj (ssname js (setq n (1- n)))
ename (vlax-ename->vla-object obj)
pr -1
)
(cond
((eq (cdr (assoc 0 (entget obj))) "LWPOLYLINE")
(repeat (fix (vlax-curve-getEndParam ename))
(setq
dist_start (vlax-curve-GetDistAtParam ename (setq pr (1+ pr)))
dist_end (vlax-curve-GetDistAtParam ename (1+ pr))
pt_start (vlax-curve-GetPointAtParam ename pr)
pt_end (vlax-curve-GetPointAtParam ename (1+ pr))
seg_len (- dist_end dist_start)
alpha (angle (trans pt_start 0 1) (trans pt_end 0 1))
val_txt (vl-string-subst "%%d" "d"(strcat (angtos alpha) "\\P " (rtos seg_len)))
dim_txt (textbox (list (cons 1 val_txt)))
)
(if (and (> alpha (* pi 0.5)) (< alpha (* pi 1.5))) (setq alpha (+ alpha pi)))
(if (> (distance (car dim_txt) (cadr dim_txt)) seg_len)
(setq val_txt (vl-string-subst "E \\P" "E " val_txt))
)
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point (setq pt (vlax-curve-GetPointAtParam ename (+ 0.5 pr))))
0.0
val_txt
)
)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
(list 5 (getvar "TEXTSIZE") 5 pt "LABEL_ARIAL" "DIMENSIONS" alpha)
)
(setq ss (ssadd (entlast) ss))
)
)
(T
(setq
pt_start (vlax-curve-GetStartPoint ename)
pt_end (vlax-curve-GetEndPoint ename)
seg_len (distance pt_start pt_end)
alpha (angle (trans pt_start 0 1) (trans pt_end 0 1))
val_txt (vl-string-subst "%%d" "d"(strcat (angtos alpha) "\\P " (rtos seg_len)))
dim_txt (textbox (list (cons 1 val_txt)))
)
(if (and (> alpha (* pi 0.5)) (< alpha (* pi 1.5))) (setq alpha (+ alpha pi)))
(if (> (distance (car dim_txt) (cadr dim_txt)) seg_len)
(setq val_txt (vl-string-subst "E \\P" "E " val_txt))
)
(setq nw_obj
(vla-addMtext Space
(vlax-3d-point (setq pt (mapcar '* (mapcar '+ (vlax-curve-GetStartPoint ename) (vlax-curve-GetEndPoint ename)) '(0.5 0.5 0.5))))
0.0
val_txt
)
)
(mapcar
'(lambda (pr val)
(vlax-put nw_obj pr val)
)
(list 'AttachmentPoint 'Height 'DrawingDirection 'InsertionPoint 'StyleName 'Layer 'Rotation)
(list 5 (getvar "TEXTSIZE") 5 pt "LABEL_ARIAL" "DIMENSIONS" alpha)
)
(setq ss (ssadd (entlast) ss))
)
)
)
(vla-endundomark AcDoc)
(mapcar 'setvar '("AUNITS" "AUPREC" "LUPREC" "LUNITS") l_var)
(sssetfirst nil ss)
(prin1)
)
I need the azimuths to come above the distances if the line direction points from 0 degrees (North) to 180 degrees (South) and I need the distances to come above the azimuths if the given line points anywhere from 180d 01' to just below 0 degrees (or 359d 59').
So far the current result is as shown:
I would like to automate the process to produce this:
Please I would very much appreciate any help given. Thanks.