Topic: Could some one help me plz , create Stations

[HasanCAD]

Hi all

a part of our work is drafting the shop drawing for PT (post tension) cable
what i am looking for is a lisp to draft the stations

- Pick pt1 and pt2
- Ask for c (low point) and L (high Point).
- Add the text as per the attached equation.

* All dim in mm
* Z direction should be ignored when picking the points
* (trans) should be considered in some cases the plan is rotated.


Thanks All

[CAB]

I seem to remember a post some years ago dealing with a hanging chain.
Don't have time to look right now though.

[irneb]

You mean something like this: http://www.digitalcad.com/2001/05_may/features/math1.htm

[HasanCAD]

Thanks CAD
Thanks irneb

I do not want to draft the curve I just want to draft the stations and text only in step 4
the elevation only for clarification

Let me show you a plan to imagine the time what I spending to calculate one by one.

Thanks again

[CAB]

Hi all

a part of our work is drafting the shop drawing for PT (post tension) cable
what i am looking for is a lisp to draft the stations

- Pick pt1 and pt2
- Ask for c (low point) and L (high Point).
- Add the text as per the attached equation.

* All dim in mm
* Z direction should be ignored when picking the points
* (trans) should be considered in some cases the plan is rotated.

Thanks All

Does the profile object exist in the drawing?
If so just pick it for the information needed if it is to scale.

I guess you would need to input the top elevation.

[HasanCAD]

Does the profile object exist in the drawing?
....

No the profile not exist.

[CAB]

Here is a starting point for you.

Code: [Select]

(defun c:PTstations(/ p1 p2 step dist #pts ang idx)

  (if (and (setq p1 (getpoint "\nPick first point."))
           (setq p2 (getpoint "\nPick second point.")))
    (progn
      (setq step 1000
            dist (distance p1 p2)
            #pts (fix (/ (/ dist step)2))
            ang  (angle p1 p2)
            idx  1
            )
      (repeat #pts
        (command "_Point" "_non" (polar p1 ang (* idx step)))
        (command "_Point" "_non" (polar p2 ang (- (* idx step))))
        (setq idx (1+ idx))
      )
    )
  )
  (princ)
)

[HasanCAD]

depending on the formula in the beginning, this is next step
but the code drafts one point only each side

Code: [Select]

(defun c:PTstations (/
     p1 p2 L c
     step dist #pts ang idx
     Xt Yt x a y
     )
 
  (if (and (setq p1 (getpoint "\nPick first point."))
           (setq p2 (getpoint "\nPick second point."))
   (setq L (getreal  "\nWhat is low point? "))
   (setq c (getreal  "\nWhat is High point? "))
   )
    (progn
      (setq step 1000
            dist (distance p1 p2)
            #pts (fix (/ (/ dist step)2))
            ang  (angle p1 p2)
            idx  1
            )
      (repeat #pts
(setq Xt (/ dist 2)
      Yt (- l c)
      x (- Xt (* idx step))
      a (/ Yt (* Xt Xt))
      y (+ (* a (* x x)) c)
      yr (round y 5)
      #pts (fix (/ (/ dist step)2))
              ang  (angle p1 p2)
              idx  1
      )
        (command "_Point" "_non" (polar p1 ang (* idx step)))
        (command "_Point" "_non" (polar p2 ang (- (* idx step))))
        (setq idx (1+ idx))
      )
    )
  )
  (princ)
)

(defun round ( number by )
    ; http://www.theswamp.org/index.php?topic=3076.0;all
    (if (zerop by) number
        (+  (* (fix (/ number (setq by (abs by)))) by)
            (if (< (* 0.5 by) (rem number by)) by  0 )))
    )

[CAB]

Try this, see comments in code.

Code: [Select]

(defun c:PTstations (/
     p1 p2 L c
     step dist #pts ang idx
     Xt Yt x a y
     )
 
  (if (and (setq p1 (getpoint "\nPick first point."))
           (setq p2 (getpoint "\nPick second point."))
   (setq L (getreal  "\nWhat is low point? "))
   (setq c (getreal  "\nWhat is High point? "))
   )
    (progn
      (setq step 1000
            dist (distance p1 p2)
            #pts (fix (/ (/ dist step)2))
            ang  (angle p1 p2)
            idx  1
            )
      (repeat #pts
(setq Xt (/ dist 2)
      Yt (- l c)
      x (- Xt (* idx step))
      a (/ Yt (* Xt Xt))
      y (+ (* a (* x x)) c)
      yr (round y 5)
              ;;  these don't belong here
      ;; #pts (fix (/ (/ dist step)2))
              ;; ang  (angle p1 p2)
              ;; idx  1
      )
        (command "_Point" "_non" (polar p1 ang (* idx step)))
        ;;  text height is 20, offset from line is 40
        (MakeText (rtos yr 2 0) (polar (polar p1 ang (* idx step)) (* pi 1.5) 40) "0" 20)
        (command "_Point" "_non" (polar p2 ang (- (* idx step))))
        (MakeText (rtos yr 2 0) (polar (polar p2 ang (- (* idx step))) (* pi 1.5) 40) "0" 20)
        (setq idx (1+ idx))
      )
    )
  )
  (princ)
)

(defun round ( number by )
    ; http://www.theswamp.org/index.php?topic=3076.0;all
    (if (zerop by) number
        (+  (* (fix (/ number (setq by (abs by)))) by)
            (if (< (* 0.5 by) (rem number by)) by  0 )))
    )



;;  pre set to Middle Center
(defun MakeText (str pt lyr ht)
  (entmakex (list (cons 0 "TEXT") ;***
                 (cons 1 str) ;* (the string itself)
                 (cons 6 "BYLAYER") ; Linetype name
                 (cons 7 "STANDARD") ;* Text style name, defaults to STANDARD, not current
                 (cons 8 lyr)   ; layer
                 (cons 10 pt) ;* First alignment point (in OCS)
                 (cons 11 pt) ;* Second alignment point (in OCS)
                 (cons 39 0.0) ; Thickness (optional; default = 0)
                 (cons 40 ht) ;* Text height
                 (cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0
                 (cons 50 0.0) ; Text rotation ange
                 (cons 51 0.0) ; Oblique angle
                 (cons 62 256) ; color
                 (cons 71 0) ; Text generation flags
                 (cons 72 1) ; Horizontal text justification type
                 (cons 73 2) ; Vertical text justification type
                 (cons 210 (list 0.0 0.0 1.0)))))

[Stefan]

This is a geometrical solution. First step only, because my results are different so I didn't go further.

Code - Auto/Visual Lisp: [Select]

1. (defun c:parabola ( / p0 p1 p2 p3 p4 c L)
2.   (if
3.     (and
4.       (setq p1 (getpoint "\nFirst point: "))
5.       (setq p2 (getpoint p1 "\nSecond point: "))
6.       (setq c (getdist "\nLowest level: "))
7.       (setq L (getdist "\nHighest level: "))
8.       (> (distance p1 p2) 0.0)
9.     )
10.      (progn
11.        (setq p0 (polar
12.                   (mapcar '(lambda (a b) (* 0.5 (+ a b))) p1 p2)
13.                   (setq u (- (angle p1 p2) (* 0.5 pi)))
14.                   (* 2.0 (- L c))
15.                 )
16.              p3 (polar p1 u L)
17.              p4 (polar p2 u L)
18.        )
19.        (entmake
20.          (append
21.            '((0 . "SPLINE")
22.              (100 . "AcDbEntity")
23.              (100 . "AcDbSpline")
24.              (70 . 8)
25.              (71 . 2)
26.              (72 . 6)
27.              (73 . 3)
28.              (74 . 0)
29.              (42 . 1.0e-10)
30.              (43 . 1.0e-10)
31.              (40 . 0.0)
32.              (40 . 0.0)
33.              (40 . 0.0)
34.              (40 . 1.0)
35.              (40 . 1.0)
36.              (40 . 1.0)
37.             )
38.            (mapcar
39.              '(lambda (x)
40.                 (cons 10 (trans x 1 0))
41.               )
42.              (list p1 p0 p2)
43.            )
44.          )
45.        )
46.        (entmake
47.          (list
48.            '(0 . "LINE")
49.            (cons 10 (trans p3 1 0))
50.            (cons 11 (trans p4 1 0))
51.          )
52.        )
53.      )
54.   )
55.   (princ)
56. )

The code above will give the same results as in attached picture, but they are different from yours.
Please check your calculus and tell me if I miss something.

[HasanCAD]

Try this, see comments in code.
...

You do not imagine how much time you saved.
Last step: This line please.

[HasanCAD]

This is a geometrical solution.

May be the result in attached not correct.
Any way, Only the plan is needed not the elevation, The elevation just of indication

Refer to the calculation, we have 2 types of calculations
- for one segment such as girder in bridges.
- for continuous tendons in slabs.

[HasanCAD]

How to make text and line perpendicular on main line

This is code

Code: [Select]

;Main
(defun c:PTS (/ p1 p2 L c step dist #pts ang idx Xt Yt x a y)

  (if (and (setq p1 (getpoint "\nPick first point."))
   (setq p2 (getpoint "\nPick second point."))
   (setq L (getreal "\nWhat is High point? "))
   (setq c (getreal "\nWhat is Low point? "))
      )
    (progn
      (setq step 1000
    dist (distance p1 p2)
    #pts (fix (/ (/ dist step) 2))
    ang (angle p1 p2)
    idx 1)
     
      (repeat #pts
(setq Xt (/ dist 2)
      Yt (- l c)
      x (- Xt (* idx step))
      a (/ Yt (* Xt Xt))
      y (+ (* a (* x x)) c)
      yr (round y 5))

(MakeText
  (rtos yr 2 0)
  (polar (polar (trans p1 1 0) ang (* idx step)) (* pi 1.5) 400)
  "0"
  200)
(MakeLine
  (polar (polar (trans p1 1 0) ang (* idx step)) (* pi 1.5) 300)
  (polar (polar (trans p1 1 0) ang (* idx step)) (* pi 1.5) -300))

(MakeText
  (rtos yr 2 0)
  (polar (polar (trans p2 1 0) ang (- (* idx step))) (* pi 1.5) 400)
  "0"
  200
  )
(MakeLine
  (polar (polar (trans p2 1 0) ang (- (* idx step))) (* pi 1.5) 300)
  (polar (polar (trans p2 1 0) ang (- (* idx step))) (* pi 1.5) -300)
)

(setq idx (1+ idx))
      )
    )
  )
  (princ)
)

; Sub

(defun round (number by) ; http://www.theswamp.org/index.php?topic=3076.0;all
  (if (zerop by)
    number
    (+ (* (fix (/ number (setq by (abs by)))) by)
       (if (< (* 0.5 by) (rem number by))
by
0))))



;  pre set to Middle Center
;  CAB
(defun MakeText (str pt lyr ht)
  (entmakex (list (cons 0 "TEXT") ;***
  (cons 1 str) ;* (the string itself)
  (cons 6 "BYLAYER") ; Linetype name
  (cons 7 "STANDARD") ;* Text style name, defaults to STANDARD, not current
  (cons 8 lyr) ; layer
  (cons 10 pt) ;* First alignment point (in OCS)
  (cons 11 pt) ;* Second alignment point (in OCS)
  (cons 39 0.0) ; Thickness (optional; default = 0)
  (cons 40 ht) ;* Text height
  (cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0
  (cons 50 0.0) ; Text rotation ange
  (cons 51 0.0) ; Oblique angle
  (cons 62 256) ; color
  (cons 71 0) ; Text generation flags
  (cons 72 1) ; Horizontal text justification type
  (cons 73 2) ; Vertical text justification type
  (cons 210 (list 0.0 0.0 1.0)))))

(defun MakeLine (p1 p2)
  (entmakex (list (cons 0 "LINE")
  (cons 10 p1)
  (cons 11 p2))))
(princ "\n Type  PTS  to Invoke")
(princ)



[ronjonp]

Try this: You have to get the perpendicular angle as well as feed the "maketext" sub a rotation.

Code: [Select]

;Main
(defun c:pts (/ #pts a ang c dist idx l p1 p2 pang step x xt y yr yt)
  (if (and (setq p1 (getpoint "\nPick first point."))
   (setq p2 (getpoint p1 "\nPick second point."))
   (setq l (getreal "\nWhat is High point? "))
   (setq c (getreal "\nWhat is Low point? "))
      )
    (progn (setq step 1000
dist (distance p1 p2)
#pts (fix (/ (/ dist step) 2))
ang  (angle p1 p2)
pang (+ ang (/ pi 2.)) ;<<<---- RJP Added perpendicular angle
idx  1
   )
   (repeat #pts
     (setq xt (/ dist 2)
   yt (- l c)
   x  (- xt (* idx step))
   a  (/ yt (* xt xt))
   y  (+ (* a (* x x)) c)
   yr (round y 5)
     )
     (maketext (rtos yr 2 0)
       (polar (polar (trans p1 1 0) ang (* idx step)) (+ pi pang) 400)
       "0"
       200
       ang
     )
     (makeline (polar (polar (trans p1 1 0) ang (* idx step)) pang 300)
       (polar (polar (trans p1 1 0) ang (* idx step)) pang -300)
     )
     (maketext (rtos yr 2 0)
       (polar (polar (trans p2 1 0) ang (- (* idx step))) (+ pi pang) 400)
       "0"
       200
       ang
     )
     (makeline (polar (polar (trans p2 1 0) ang (- (* idx step))) pang 300)
       (polar (polar (trans p2 1 0) ang (- (* idx step))) pang -300)
     )
     (setq idx (1+ idx))
   )
    )
  )
  (princ)
)

; Sub

(defun round (number by) ; http://www.theswamp.org/index.php?topic=3076.0;all
  (if (zerop by)
    number
    (+ (* (fix (/ number (setq by (abs by)))) by)
       (if (< (* 0.5 by) (rem number by))
by
0
       )
    )
  )
)



;  pre set to Middle Center
;  CAB
(defun maketext (str pt lyr ht rot)
  (entmakex (list (cons 0 "TEXT") ;***
  (cons 1 str) ;* (the string itself)
  (cons 6 "BYLAYER") ; Linetype name
  (cons 7 "STANDARD") ;* Text style name, defaults to STANDARD, not current
  (cons 8 lyr) ; layer
  (cons 10 pt) ;* First alignment point (in OCS)
  (cons 11 pt) ;* Second alignment point (in OCS)
  (cons 39 0.0) ; Thickness (optional; default = 0)
  (cons 40 ht) ;* Text height
  (cons 41 1.0) ; Relative X scale factor, Width Factor, defaults to 1.0
  (cons 50 rot) ; <<<----- RJP ADDED Text rotation angle
  (cons 51 0.0) ; Oblique angle
  (cons 62 256) ; color
  (cons 71 0) ; Text generation flags
  (cons 72 1) ; Horizontal text justification type
  (cons 73 2) ; Vertical text justification type
  (cons 210 (list 0.0 0.0 1.0))
    )
  )
)

(defun makeline (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2))))
(princ "\n Type  PTS  to Invoke")
(princ)


[HasanCAD]

Try this:
...

Thanks,
This is what I am looking for

[HasanCAD]

This is Rev 1

Code: [Select]

;|---------------Layers List--------------------
    q_|_|| _\|| q_|| _\|

  Create stations for Prestresed tendon

------------------------------------------------
  Author: Hasan M. Asous, 2010
ALL RIGHT RESERVED TO ALL
  Contact: HasanCAD @ TheSwamp.org,
           asos2000 @ CADTutor.net
           HasanCAD@gmail.com
------------------------------------------------
  Version: 1      2012 06 10
________________________________________________
      |;

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine Start      ;
(defun c:pts (/    p1 p2   tmp  step dist #pt ang  pang idx #pts
      Dst2 STxt Spt1 Spt2 Dst1 S    SS SS2  SS4  S42 X1
      X    XX XXA  XB   XAB  Lc   Lc1 LcD  a1   ys1 yc
      A    B y    yr
     )


  (while T
    (if (and (setq p1 (getpoint "\nPick first point."))
     (setq p2 (getpoint p1 "\nPick second point."))
     (if (< (car p2) (car p1))
       (setq tmp p1 p1 p2 p2 tmp) T)
     (setq *L* (cond ((getint (strcat "\nWhat is HIGH Point <" (itoa (setq *L* (cond (*L*)
    (160)))) ">: " ))) (*L*)))
     (setq *c* (cond ((getint (strcat "\nWhat is LOW Point <" (itoa (setq *c* (cond (*c*) (35)))) ">: " ))) (*c*)))
     (setq step 1000)
     (setq dist (distance p1 p2))
     (setq #pt (fix (/ (/ dist step) 2)))
     (setq ang (angle p1 p2))
     (setq pang (+ ang (/ pi 2.)))
     (setq idx 1)
     (setq mp (list (/ (+ (car p1) (car p2)) 2)
    (/ (+ (cadr p1) (cadr p2)) 2))))

      (progn
(if (< (car p2) (car p1))
  (mapcar 'set '(p1 p2) (list p2 p1))
)
(makeline (polar (polar (trans p1 1 0) ang 0) pang 150)
  (polar (polar (trans p1 1 0) ang 0) pang -150)
)
(makeline (polar (polar (trans p2 1 0) ang 0) pang 150)
  (polar (polar (trans p2 1 0) ang 0) pang -150)
)
(makeline (polar (polar (trans mp 1 0) ang 0) pang 150)
  (polar (polar (trans mp 1 0) ang 0) pang -150)
)

(if (< (- (/ dist 2) (* #pt step)) 150)
  (progn
    (setq #pts (- #pt 1))

    (repeat #pts
      (_repeat)
      (setq idx (1+ idx))
    )
    (setq SPT11 (+ (* idx step) (- Dst2 (* idx step))))
    (setq STxt (itoa (fix (- (/ dist 2) (* #pts step)))))
    (setq Spt1 (polar (polar (trans p1 1 0) ang (* idx step))
      (+ pi pang)
      -250
       )
    )
    (setq
      Spt2 (polar (polar (trans p2 1 0) ang (- (* idx step)))
  (+ pi pang)
  -250
   )
    )
    (setq mps1 (list (/ (+ (car mp) (car Spt1)) 2)
     (/ (+ (cadr mp) (cadr Spt1)) 2)
       )
    )
    (setq mps2 (list (/ (+ (car mp) (car Spt2)) 2)
     (/ (+ (cadr mp) (cadr Spt2)) 2)
       )
    )

    (maketext STxt mps1 "0" 200 ang)
    (maketext STxt mps2 "0" 200 ang)

  )
  (progn
    (setq #pts #pt)
    (repeat #pts
      (_repeat)
      (setq idx (1+ idx))
    )
    (setq LTxt (itoa (fix (- (/ dist 2) (* #pts step)))))
    (setq Lpt1 (polar (polar (trans p1 1 0) ang (* idx step))
      (+ pi pang)
      -250
       )
    )
    (setq
      Lpt2 (polar (polar (trans p2 1 0) ang (- (* idx step)))
  (+ pi pang)
  -250
   )
    )
    (maketext LTxt Lpt1 "0" 200 ang)

    (maketext LTxt Lpt2 "0" 200 ang)
  )
)
      )
      (princ)
    )
  )
)

;     q_|_|| _\|| q_|| _\|     ;
;       Mainroutine End        ;

;     q_|_|| _\|| q_|| _\|     ;
;       Subroutine Start       ;

(defun round (number by) ; http://www.theswamp.org/index.php?topic=3076.0;all
  (if (zerop by)
    number
    (+ (* (fix (/ number (setq by (abs by)))) by)
       (if (< (* 0.5 by) (rem number by))
by
0
       )
    )
  )
)

; CAB  pre set to Middle Center
(defun maketext (str pt lyr ht rot)
  (entmakex (list (cons 0 "TEXT") ;***
  (cons 1 str) ;* (the string itself)
  (cons 6 "BYLAYER") ; Linetype name
  (cons 7 (getvar "TEXTSTYLE"))
;* Text style name, defaults to STANDARD, current
  (cons 8 (getvar "CLAYER")) ; layer
  (cons 10 pt) ;* First alignment point (in OCS)
  (cons 11 pt) ;* Second alignment point (in OCS)
  (cons 39 0.0) ; Thickness (optional; default = 0)
  (cons 40 ht) ;* Text height
  (cons 41 0.8) ; Relative X scale factor, Width Factor, defaults to 1.0
  (cons 50 rot) ; <<<----- RJP ADDED Text rotation angle
  (cons 51 0.0) ; Oblique angle
  (cons 62 256) ; color
  (cons 71 0) ; Text generation flags
  (cons 72 1) ; Horizontal text justification type
  (cons 73 2) ; Vertical text justification type
  (cons 210 (list 0.0 0.0 1.0))
    )
  )
)

(defun makeline (p1 p2)
  (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)

(defun _repeat (/)
  (equation)

  (maketext yt (polar (polar (trans p1 1 0) ang X1) (+ pi pang) 250)
    "0"
    200
    ang
  )
  (makeline (polar (polar (trans p1 1 0) ang X1) pang 150)
    (polar (polar (trans p1 1 0) ang X1) pang -150)
  )
  (maketext yt (polar (polar (trans p2 1 0) ang (- X1)) (+ pi pang) 250)
    "0"
    200
    ang
  )
  (makeline (polar (polar (trans p2 1 0) ang (- X1)) pang 150)
    (polar (polar (trans p2 1 0) ang (- x1)) pang -150)
  )
)

(defun equation (/)
  (setq Dst2 (/ Dist 2)
Dst1 (* 0.1 Dist)
S    (* 0.8 Dist)
SS   (* S S)
SS2  (/ SS 2)
SS4  (/ SS 4)
S42  (- SS4 SS2)
X1   (* idx step)
X    (- (* idx step) Dst1)
XX   (* X X)
Lc   (- *L* *c*)
Lc1  (* Lc 0.1)
LcD  (* Lc1 Dist)
a1   (/ LcD Dst2)
ys1  (- *L* a1)
yc   (- *c* ys1)
A    (/ yc S42)
AS   (* A S)
B    (- AS)
XXA  (* A XX)
XB   (* B X)
XAB  (+ XXA XB)
y    (+ XAB ys1)
yt   (rtos (round y 5) 2 0)
  )
)

(defun *error* (msg)
  (and oldNomutt (setvar 'nomutt oldNomutt))
  (cond ((not msg)) ; Normal exit
((member msg '("Function cancelled" "quit / exit abort")))
; <esc> or (quit)
((princ (strcat "\n** Error: " msg " ** ")))
  ) ; Fatal error, display it
  (if result
    result
    (princ)
  )
)

;     q_|_|| _\|| q_|| _\|     ;
;        Subroutine End        ;
(princ "\n Type  PTS  to Invoke")
(princ)