This is Rev 1
;|---------------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)
