Please help me poly line length from start with Curve up to tp-1(+) from tp-1 to IP distace (place as apex at km ?

[kkr028]

Please help me with lisp

poly line length from start with Curve up to tp-1(+) from tp-1 to IP distace (place as apex at km ?

[ВeekeeCZ]

something quick.

(vl-load-com)

(defun c:apex ( / p v)
  
  (and (setq p (car (entsel "polyline: ")))
       (vl-cmdf "_copy" p "" '(0 0) '(0 0))
       (setvar 'filletrad 0)
       (setq p (entlast))
       (vl-cmdf "_fillet" "_P" (entlast) "")
       (setq v (mapcar 'cdr (reverse (cdr (reverse (cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget p))))))))
       (foreach x v (entmakex (list '(0 . "TEXT") (cons 10 x) '(40 . 1) (cons 1 (strcat "APEX AT KM " (rtos (vlax-curve-getdistatpoint p x) 2 3))))))
       (entdel p)
       )
  (princ)
  )

[CADaSchtroumpf]

This?

Place MLEADER at vertex and give the length of the tangent for ARC or POLYARC

(vl-load-com)
(defun make_mlead (pt o d / ptlst arr nw_obj)
  (setq
    ptlst (append pt (polar pt o d))
    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|b0|i0|c0|p34;+" (rtos d 2 3) "}"))
  (vla-put-layer nw_obj (getvar "CLAYER"))
  (vla-put-ArrowheadSize nw_obj (* (getvar "TEXTSIZE") 0.5))
  (vla-put-TextHeight nw_obj (getvar "TEXTSIZE"))
  (if (> (car ptlst) (cadddr ptlst))
    (progn
      (vla-SetDogLegDirection nw_obj 0 (vlax-3D-point '(-1.0 0.0 0.0)))
      (vla-put-TextJustify nw_obj acAttachmentPointMiddleRight)
      (vla-setLeaderLineVertices nw_obj 0 (vlax-make-variant arr))
    )
    (vla-put-TextJustify nw_obj acAttachmentPointMiddleLeft)
  )
  (vla-update nw_obj)
)
(defun c:Lenght_Tangent ( / js n AcDoc Space ename obj pr nb typ_obj oldim oldlay a_base a_dir pt_start pt_end pt_cen rad alpha pt_vtx x dist_start dist_end seg_len seg_bulge)
  (princ "\nSelect 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" "Length Tangent"))
          (vlax-put (vla-add (vla-get-layers AcDoc) "Length Tangent") 'Color "5")
        )
      )
      (setq
        oldim (getvar "dimzin")
        oldlay (getvar "clayer")
        a_base (getvar "ANGBASE")
        a_dir (getvar "ANGDIR")
      )
      (setvar "dimzin" 0) (setvar "clayer" "Length Tangent")
      (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))))))
              nb (1+ nb)
              x (angle pt_cen pt_vtx)
            )
            (make_mlead pt_vtx x (distance pt_start pt_vtx))
          )
          (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_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)
                  x (angle pt_cen pt_vtx)
                )
                (make_mlead pt_vtx x (distance pt_start pt_vtx))
              )
            )
          )
        )
      )
      (setvar "dimzin" oldim) (setvar "clayer" oldlay)
      (setvar "ANGBASE" a_base) (setvar "ANGDIR" a_dir)
    )
  )
  (prin1)
)

[3wood]

It seems the red part is not in the result.

[ronjonp]

Answers HERE too.

[john.uhden]

@3wood ,

@ВeekeeCZ provided a VERY clever solution.  What, did you want the tangents drawn in red?

I know that we sometimes (or at least used to) draw the profile tangents in a very fine line or dash, but never horizontal curves.

[Sea-Haven]

Asked over at cadtutor as well, for us civil engineers

[john.uhden]

@Sea-Haven 

Good diagram.  I used to know all those formulas by heart.  Don't need to these days.

In the US we call them PIs (Point of Intersection).  Then the radius  is assigned and we compute the tangent just to get the station (chainage) of the PC.  I don't think there's any other purpose.

Back in the day, the survey crew would find the intersection of the two tangents in the field (even if in the woods), then set up there and measure the delta from back to forward.  Clearing brush and felling trees were all part of the process.  Usually a 3-man or 4-man crew.  If they had a slide rule they could lay out the curve in the same or next day.

[Sea-Haven]

Yeah "If they had a slide rule they could lay out the curve in the same or next day." Now 1 man total station upload alignment enter chainage instrument works out pt. 

We just make a setout file and give to surveyor usually a picture as well so gets an idea of where points are even in trees. So why need the request ???

[kkr028]

actually we place labels on alignment in longitudinal sections.

please any one help me out with lisp.  

[kkr028]

actually i need this

TP1 length = Curve polyline length up to every TP-1 and place text as " TP-1@ ??.??? KM' "
TP2 length = Curve polyline length up to every TP-2 and place text as " TP-2@ ??.??? KM' "
APEX length = (Curve polyline length up to every TP-1 + tangent length and place text as " APEX-? AT ??.??? KM "
FORWARD BARRING = place text as " FB : ???° ??' ?? "

 

[CADaSchtroumpf · Accepted solution]

Have you see my answer HERE ?

[Sea-Haven]

Asking at cadtutor as well answer is not getting to him/her fast enough, dont worry about those paying jobs drop everything and do the free ones.

[CADaSchtroumpf]

---

@Sea-Haven  a écrit :

Asking at cadtutor as well answer is not getting to him/her fast enough, dont worry about those paying jobs drop everything and do the free ones.

---

@Sea-Haven 

Ah yes I see now!
He does multi-posting, does not respond to proposals, and eternally asks the same question !!!...
Not encouraging to follow his request.