lisp for Labeling angle, radius, tangent distance & external distance in civil3d

[tohid_alizadeh70]

Hi, i need a lisp to label some curve calculator values of civil 3D Like angle, radius, tangent distanse & external distance. i  wrote a code but it's not like what I need (screenshot attached) and has wrong value (T & E). My code:

----------------------------------

(defun c:tafsili (/ ss acadModel precision ctr obj len rad ang txt txtObj tanDist extDist)
(if (setq ss (ssget '((0 . "ARC"))))
(progn
(setq acadModel (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
(setq precision 2)
(setq ctr 0)
(repeat (sslength ss)
(setq obj (vlax-ename->vla-object (ssname ss ctr)))
(setq rad (rtos (vla-get-radius obj) 2 precision))
(setq ang (rtos (cvunit (vla-get-totalAngle obj) "radians" "degrees") 2 precision))
(setq tanDist (rtos (vlax-curve-getDistAtPoint obj (vlax-curve-getEndPoint obj)) 2 precision)) ; Wrong
(setq extDist (rtos (vlax-curve-getDistAtPoint obj (vlax-curve-getStartPoint obj)) 2 precision)) ; Wrong

(setq txt (strcat " A=" ang "°" " R=" rad "m" " T=" tanDist "m" " E=" extDist "m"))
(setq txtObj (vla-addtext acadModel txt (vla-get-center obj) 1))
(vla-put-alignment txtObj acAlignmentMiddleCenter)
(vla-put-textAlignmentPoint txtObj (vla-get-center obj))
(setq ctr (1+ ctr))
)
)
)
(princ)
)

[CADaSchtroumpf · Accepted solution]

Hi,

My code used to achieve this, polyarcs and arcs can be selected.

[tohid_alizadeh70]

I am deeply grateful for your assistance.

[tohid_alizadeh70]

is it possible to draw an arrow from this box to midpoint of the arc (like my attached screenshot) in this lsp?

[CADaSchtroumpf · Accepted solution]

@tohid_alizadeh70 

Hi,

You can try this version with leader

(vl-load-com)
(defun c:ARTDB ( / js n AcDoc Space ename obj pr nb typ_obj oldim oldlay a_base a_dir h_t
 pt_start pt_end pt_cen rad alpha pt_vtx pt_mid dist_start dist_end seg_len seg_bulge)
  (defun make_mlead (pt obj / ptlst arr nw_obj)
    (setq
      ptlst (append pt (polar pt (angle pt_cen pt_mid) (/ rad 3)))
      arr (vlax-make-safearray vlax-vbdouble (cons 0 (- (length ptlst) 1)))
    )
    (vlax-safearray-fill arr ptlst)
    (setq nw_obj (vla-addMLeader Space (vlax-make-variant arr) 0))
    (vla-put-contenttype nw_obj acMTextContent)
    (vla-put-textstring nw_obj 
      (strcat
        "{\\fArial Narrow|b0|i0|c0|p34;"
        "A = " (angtos (- pi (* 2 alpha)) 0 4) "%%d"
        "\\PR = " (rtos rad 2 3)
        "\\PT = " (rtos (distance pt_start pt_vtx) 2 3)
        "\\PD = " (rtos seg_len 2 3)
        "\\PB = " (rtos (- (distance pt_cen pt_vtx) (abs rad)) 2 3)
        "}"
      )
    )
    (mapcar
      '(lambda (x)
        (entmod (subst x (assoc (car x) (entget (entlast))) (entget (entlast))))
      )
      (list
        '(91 . -1023417196)
        '(292 . 1)
        '(141 . 1.5)
      )
    )
    (entupd (entlast))
    (vla-put-layer nw_obj (getvar "CLAYER"))
    (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
    (vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
    (vla-update nw_obj)
  )
  (princ "\nSélectionner des Arcs/PolyArcs .")
  (setq
    js
    (ssget
      '((-4 . "<OR")
        (-4 . "<AND")
          (0 . "POLYLINE")
          (-4 . "<NOT")
            (-4 . "&") (70 . 126)
          (-4 . "NOT>")
        (-4 . "AND>")
        (0 . "LWPOLYLINE,ARC")
        (-4 . "OR>"))
    )
    n -1
  )
  (cond
    (js
      (setq
        AcDoc (vla-get-ActiveDocument (vlax-get-acad-object))
        Space
          (if (= 1 (getvar "CVPORT"))
            (vla-get-PaperSpace AcDoc)
            (vla-get-ModelSpace AcDoc)
          )
        nb 0
      )
      (cond
        ((null (tblsearch "LAYER" "Info ARTDB des Arcs"))
          (vlax-put (vla-add (vla-get-layers AcDoc) "Info ARTDB des Arcs") 'Color "5")
        )
      )
      (setq
        oldim (getvar "dimzin")
        oldlay (getvar "clayer")
        a_base (getvar "ANGBASE")
        a_dir (getvar "ANGDIR")
        h_t (getdist (getvar "viewctr") (strcat "\nTaille du texte <" (rtos (getvar "textsize")) ">: "))
      )
      (if (null h_t) (setq h_t (getvar "textsize")) (setvar "textsize" h_t))
      (setvar "dimzin" 0) (setvar "clayer" "Info ARTDB des Arcs")
      (setvar "ANGBASE" 0) (setvar "ANGDIR" 0)
      (repeat (sslength js)
        (setq
          ename (ssname js (setq n (1+ n)))
          obj (vlax-ename->vla-object ename)
          pr -1
          nb 0
        )
        (setq typ_obj (vla-get-ObjectName obj))
        (if (eq typ_obj "AcDbArc")
          (progn
            (setq
              pt_start (vlax-get obj 'StartPoint)
              pt_end (vlax-get obj 'EndPoint)
              pt_cen (vlax-get obj 'Center)
              rad (vlax-get obj 'Radius)
              alpha (* (vlax-get obj 'TotalAngle) 0.5)
              seg_len (vlax-get obj 'ArcLength)
              pt_vtx (polar pt_cen (+ (vlax-get obj 'StartAngle) alpha) (+ rad (* rad (1- (/ 1 (cos alpha))))))
              pt_mid (polar pt_cen (+ (vlax-get obj 'StartAngle) alpha) rad)
              nb (1+ nb)
            )
            (make_mlead pt_mid obj)
          )
          (repeat (fix (vlax-curve-getEndParam obj))
            (setq
              dist_start (vlax-curve-GetDistAtParam obj (setq pr (1+ pr)))
              dist_end (vlax-curve-GetDistAtParam obj (1+ pr))
              pt_start   (vlax-curve-GetPointAtParam obj pr)
              pt_mid (vlax-curve-GetPointAtParam obj (+ 0.5 pr))
              pt_end (vlax-curve-GetPointAtParam obj (1+ pr))
              seg_len (- dist_end dist_start)
              seg_bulge (vla-GetBulge obj pr)
            )
            (if (not (zerop seg_bulge))
              (progn
                (setq
                  rad (/ seg_len (* 4.0 (atan seg_bulge)))
                  alpha (+ (angle pt_start pt_end) (- (* pi 0.5) (* 2.0 (atan seg_bulge))))
                  pt_cen (polar pt_start alpha rad)
                  pt_vtx (polar pt_start (- alpha (* pi 0.5)) (* rad (/ (sin (* 2.0 (atan seg_bulge))) (cos (* 2.0 (atan seg_bulge))))))
                  alpha (if (< (* 2.0 (atan seg_bulge)) 0) (- pi (* 2.0 (atan seg_bulge))) (* 2.0 (atan seg_bulge)))
                  nb (1+ nb)
                )
                (make_mlead pt_mid obj)
              )
            )
          )
        )
      )
      (setvar "dimzin" oldim) (setvar "clayer" oldlay)
      (setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
    )
  )
  (prin1)
)