Search the Community

Hello Lisp Nerds. could anyone help me find Distances from Shuttering plate to Tendon Outer Lines. my requiremtns are Dist 1 & Dist 2. Center line of WEB & shuttering will be polyline & it may has curves as the bridge goes. i wish to take C/L of WEB as reference line and make DIST 1 & DIST 2 at every 1meter intervals. we have a lisp that gives vertical distance between Shuttering and Tendon Outer lines. but we want it Perpendicular to shuttering.. Could anyone help me? i have attached that Lisp too. (defun tbrtos ( txt / cont txt1 txt2 txt3 tx4 txt5 txt6 aux1 aux2 aux3 aux4 aux5 aux6) (setq aux1 (strlen txt)) (setq aux2 0) (setq aux3 0) (setq aux4 0) (setq aux5 0) (setq cont 0) (repeat aux1 (setq aux2 (+ 1 aux2)) (setq txt1 (substr txt aux2 1)) (if (or (= txt1 ".") (= txt1 ",")) (SETQ cont (- aux1 aux2)) )) (setq cont cont)) (defun txfix (num dec / aux1 aux2 aux3 txt1 txt2 txt3) (if (= dec 0) (setq txt4 (rtos num 2 dec)) (progn (setq aux1 1.0) (repeat dec ; (print aux1) (setq aux1 (* 10.0 aux1))) (setq aux2 (* aux1 num)) ;(print aux2) (setq txt1 (rtos aux2 2 0)) ;(print txt1) (setq txt2 (substr txt1 1 (- (strlen txt1) dec))) ;(print txt2) (setq txt3 (substr txt1 (+ 1 (- (strlen txt1) dec)) dec)); (print txt3) (setq txt4 (strcat txt2 "." txt3)) )) (setq txt4 txt4) ) (defun txtadd ( / diff ss sl sn en data txt1 ) (setq diff (getreal "Enter +/- DELTA: ")) (PRINT "SELECT TXT...........") (setq ss (ssget)) (setq sl (sslength ss)) (while (> sl 0) (setq data 0) (setq sn (ssname ss (- sl 1))) (setq en (entget sn)) (if (= (cdr (assoc 0 en)) "TEXT") (progn (setq txt1 (cdr (assoc 1 en))) (setq data (atof txt1 )) (setq data (+ diff data )) (setq txt5 (txfix data (tbrtos txt1) )) (setq en (subst (cons 1 txt5) (assoc 1 en) en )) (entmod en) )) (setq sl (- sl 1)) ) (command "regenall") (print "END ...") ) (defun txtmult ( / diff ss sl sn en data txt1 txt5) (setq diff (getreal "Enter factor: ")) (PRINT "SELECT TXT...........") (setq ss (ssget)) (setq sl (sslength ss)) (while (> sl 0) (setq data 0) (setq sn (ssname ss (- sl 1))) (setq en (entget sn)) (if (= (cdr (assoc 0 en)) "TEXT") (progn (setq txt1 (cdr (assoc 1 en))) (setq data (atof txt1 )) (setq data (* diff data)) (setq txt5 (txfix data (tbrtos txt1) )) (setq en (subst (cons 1 txt5) (assoc 1 en) en )) (entmod en) )) (setq sl (- sl 1)) ) (command "regenall") (print "END ...") ) (defun tblayout (/ ang0 delta ss0 ss1 ss2 sl0 sl1 sn0 sn1 sn2 en0 en1 en2 p0 p1 dx dxacum dxtotal count x0 x1 x2 y0 y1 y2 ytext p2 p3 p20 p30 ptext dh ) (setq delta 100000.0) (setq ALT1 300.0) (command "_ucs" "_w" ) (print "...select reference object......") (setq ss0 (ssget)) (terpri) (print "...select tendon......") (setq ss1 (ssget)) (terpri) (setq p0 (getpoint "..........First Point........")) (terpri) (setq p1 (getpoint p0 "..........Last Point........")) (terpri) (setq ptext (getpoint p0 "..TEXT LEVEL....")) (terpri) (terpri) (setq dx (getreal "..........typical spacing........")) (setvar "osmode" 0) (setq ytext (distance p0 ptext)) (setq sl0 (sslength ss0)) (setq sn0 (ssname ss0 (- sl0 1))) ;; Get entity name (setq en0 (entget sn0)) ;; Get entity structure (setq sl1 (sslength ss1)) (setq sn1 (ssname ss1 (- sl1 1))) ;; Get entity name (setq en1 (entget sn1)) ;; Get entity structure (setq dxtotal (distance p0 p1)) (setq x0 (car p0)) (setq x1 (car p1)) (setq y0 (min (cadr p0) (cadr p1))) (setq ang0 (angle p0 p1)) (setq p2 (polar p0 (+ ang0 (* 1.5 pi)) delta)) (setq p3 (polar p0 (+ ang0 (* 0.5 pi)) delta)) (setq ptext (polar p0 (+ ang0 (* 1.5 pi)) ytext)) (setq dxacum 0.0) (while (not (> dxacum dxtotal)) (setq p20 (tbinter sn0 p2 p3)) (setq p30 (tbinter sn1 p2 p3)) (setq dh (distance p20 p30)) (command "_TEXT" "J" "BL" ptext ALT1 (+ 90.0 (* (/ ang0 pi) 180.0)) (rtos dh 2 0) ) (command "_TEXT" "J" "BL" (polar ptext (+ ang0 (* 0.5 pi)) (* 10.0 ALT1)) ALT1 (+ 90.0 (* (/ ang0 pi) 180.0)) (rtos (/ dxacum 1000.0) 2 3) ) (setq dxacum (+ dxacum dx)) (setq p2 (polar p2 ang0 dx)) (setq p3 (polar p3 ang0 dx)) (setq ptext (polar ptext ang0 dx)) ) (if (not (= dxacum dxtotal)) (progn (setq p2 (polar p1 (+ ang0 (* 1.5 pi)) delta)) (setq p3 (polar p1 (+ ang0 (* 0.5 pi)) delta)) (setq p20 (tbinter sn0 p2 p3)) (setq p30 (tbinter sn1 p2 p3)) (setq dh (distance p20 p30)) (setq ptext (polar p1 (+ ang0 (* 1.5 pi)) ytext)) (command "_TEXT" "J" "BL" ptext ALT1 (+ 90.0 (* (/ ang0 pi) 180.0)) (rtos dh 2 0) ) (command "_TEXT" "J" "BL" (polar ptext (+ ang0 (* 0.5 pi)) (* 10.0 ALT1)) ALT1 (+ 90.0 (* (/ ang0 pi) 180.0)) (rtos (/ dxtotal 1000.0) 2 3) ) ) (terpri) ) (terpri) (print "........end") (terpri) (setvar "osmode" 15359) (terpri) ) (defun tbcircle (/ sn0 llx0 x1 y1 x2 y2 x0 y0 sn2 en2 sn3 en3 sn4 en4 p4 p5 p0) (setq delta 1000) (setvar "plinetype" 0) (print "...select tendon...") (setvar sn0 (ssget)) (terpri) (print "...select 1st point...") (setvar p1 (getpoint)) (command "circle" p1 delta "") (setq sn1 (entlast)) (command "_trim" sn0 "" (entlast) "") (setq sn2 (entlast)) (setq en2 (entget sn2)) (setq sn3 (entnext sn2)) (setq en3 (entget sn3)) (setq p4 (cdr (assoc 10 en3))) (setq sn4 (entnext sn3)) (setq en4 (entget sn4)) (setq p5 (cdr (assoc 10 en4))) (command "_erase" sn2 "") (if (or (and (= (car p4) x1) (= (cadr p4) y1)) (and (= (car p4) x2) (= (cadr p4) y2)) ) (setq p0 p5) (setq p0 p4) ) (setq p0 p0) ) (defun tbinter (sn0 p1 p2 / x1 y1 x2 y2 x0 y0 sn2 en2 sn3 en3 sn4 en4 p4 p5 p0) (setvar "plinetype" 0) (setq x1 (car p1)) (setq x2 (car p2)) (setq y1 (cadr p1)) (setq y2 (cadr p2)) (command "_pline" p1 p2 "") (command "_trim" sn0 "" (entlast) "") (setq sn2 (entlast)) (setq en2 (entget sn2)) (setq sn3 (entnext sn2)) (setq en3 (entget sn3)) (setq p4 (cdr (assoc 10 en3))) (setq sn4 (entnext sn3)) (setq en4 (entget sn4)) (setq p5 (cdr (assoc 10 en4))) (command "_erase" sn2 "") (if (or (and (= (car p4) x1) (= (cadr p4) y1)) (and (= (car p4) x2) (= (cadr p4) y2)) ) (setq p0 p5) (setq p0 p4) ) (setq p0 p0) ) (defun tbangle (x1 y1 z1 x2 y2 z2 x3 y3 z3 / ppunto temp dx1 dy1 dz1 dd1 dx2 dy2 dz2 dd2) (setq dx1 (- x2 x1)) (setq dy1 (- y2 y1)) (setq dz1 (- z2 z1)) (setq dd1 (sqrt (+ (* dx1 dx1) (* dy1 dy1) (* dz1 dz1)))) (setq dx1 (/ dx1 dd1)) (setq dy1 (/ dy1 dd1)) (setq dz1 (/ dz1 dd1)) (setq dx2 (- x3 x2)) (setq dy2 (- y3 y2)) (setq dz2 (- z3 z2)) (setq dd2 (sqrt (+ (* dx2 dx2) (* dy2 dy2) (* dz2 dz2)))) (setq dx2 (/ dx2 dd2)) (setq dy2 (/ dy2 dd2)) (setq dz2 (/ dz2 dd2)) (setq temp (+ (* dx1 dx2) (* dy1 dy2) (* dz1 dz2))) (setq ppunto (acos temp)) ;.......................... ;(print temp) (print ppunto) ;......................... (setq ppunto ppunto) ) (defun tbdist (x1 y1 z1 x2 y2 z2 / ppunto dx1 dy1 dz1 dd1 dx2 dy2 dz2 dd2) (setq dx1 (- x2 x1)) (setq dy1 (- y2 y1)) (setq dz1 (- z2 z1)) (setq dd1 (sqrt (+ (* dx1 dx1) (* dy1 dy1) (* dz1 dz1)))) (setq dd1 dd1) ) (defun tbdataxy (FICHA / llx lly ang0 delta ss0 ss1 ss2 sl0 sl1 sn0 sn1 sn2 en0 en1 en2 p0 p1 dx dxacum dxtotal count x0 x1 x2 y0 y1 y2 y30 ytext p2 p3 p20 p30 ptext pref yref dh dxval ) (setq delta 100000.0) (setq ALT1 300.0) (print "...ELEVATION/PLAN VIEW ......") ; (terpri) (print "...select CG tendon......") (setq ss1 (ssget)) (terpri) (setq p0 (getpoint "..........First Point........")) (terpri) (setq p1 (getpoint p0 "..........Last Point........")) (terpri) (setq pref (getpoint "..........Reference Point........")) (terpri) (setq dx (getreal "..........typical spacing........")) (setvar "osmode" 0) ; (setq sl0 (sslength ss0)) ; (setq sn0 (ssname ss0 (- sl0 1))) ;; Get entity name ; (setq en0 (entget sn0)) ;; Get entity structure (setq yref (nth 1 pref)) (setq sl1 (sslength ss1)) (setq sn1 (ssname ss1 (- sl1 1))) ;; Get entity name (setq en1 (entget sn1)) ;; Get entity structure ; (setq dxtotal (distance p0 p1)) (setq x0 (car p0)) (setq x1 (car p1)) (setq dxval (- x1 x0)) (setq dxtotal (abs (- x1 x0))) (setq y0 (min (cadr p0) (cadr p1))) ; (setq ang0 (angle p0 p1)) (setq ang0 0.0) ; (setq p2 (polar p0 (+ ang0 (* 1.5 pi)) delta)) ; (setq p3 (polar p0 (+ ang0 (* 0.5 pi)) delta)) (setq p2 (list x0 (- (cadr p0) delta))) (setq p3 (list x0 (+ (cadr p0) delta))) (setq dxacum 0.0) (while (not (> dxacum dxtotal )) ; (setq p20 (tbinter sn0 p2 p3)) (setq p30 (tbinter sn1 p2 p3)) (setq y30 (nth 1 p30)) (setq dh (- y30 yref)) (if (= dh delta) (progn (terpri) (print " xxx NO INTERSECTION OF TENDON WITH REFERENCE OBJECT....PLEASE CHECK FIRST/LAST POINT XXXX" ) (close FICHA) (QUIT) ) ) (if (= dxacum 0.0) (progn (setq llx (list dxacum)) (setq lly (list dh)) ) (progn (setq ltemp llx) (setq llx (cons dxacum ltemp)) (setq ltemp lly) (setq lly (cons dh ltemp)) ) ) ; (command "_TEXT" "J" "BL" ptext ALT1 (+ 90.0 (* (/ ang0 pi) 180.0) ) (rtos dh 2 0)) ; (command "_TEXT" "J" "BL" (polar ptext (+ ang0 (* 0.5 pi)) (* 10.0 ALT1)) ALT1 (+ 90.0 (* (/ ang0 pi) 180.0) ) (rtos (/ dxacum 1000.0) 2 3)) (setq dxacum (+ dxacum dx)) (setq p2 (polar p2 ang0 (* dx (/ dxval dxtotal)) )) (setq p3 (polar p3 ang0 (* dx (/ dxval dxtotal)) )) ) (if (not (= dxacum dxtotal)) (progn (setq p2 (polar p1 (+ ang0 (* 1.5 pi)) delta)) (setq p3 (polar p1 (+ ang0 (* 0.5 pi)) delta)) ; (setq p20 (tbinter sn0 p2 p3)) (setq p30 (tbinter sn1 p2 p3)) ; (setq dh (distance p20 p30)) (setq y30 (nth 1 p30)) (setq dh (- y30 yref)) (if (= dh delta) (progn (terpri) (print " xxx NO INTERSECTION OF TENDON WITH REFERENCE OBJECT....PLEASE CHECK FIRST/LAST POINT XXXX" ) (close FICHA) (QUIT) ) ) (setq ltemp llx) (setq llx (cons dxtotal ltemp)) (setq ltemp lly) (setq lly (cons dh ltemp)) )) (setq llx (reverse llx)) (setq lly (reverse lly)) (setvar "osmode" 15359) (setq data (list llx lly)) (setq data data) ) (defun tbdataz1 (listax listay Radio / x0 y0 z0 nx ltemp count acum) (setq nx (length listax)) (setq count 0) (setq y1 (nth count listay)) (repeat nx (setq x0 (nth count listax)) (setq y0 (nth count listay)) (setq z0 (* Radio (cos (/ x0 Radio)))) (if (= count 0) (progn (setq llz (list z0)) ) (progn (setq ltemp llz) (setq llz (cons z0 ltemp)) ) ) (setq count (+ 1 count)) ) (setq llz (reverse llz)) (terpri) (setq llz llz) ) (defun tbdataz2 (listax listay wslope offset duct / x0 y0 z0 nx ltemp count acum ycorr ) (setq nx (length listax)) (setq count 0) (setq y1 (nth count listay)) (repeat nx (setq x0 (nth count listax)) (setq y0 (nth count listay)) (setq ycorr (- y0 (/ duct 2.0))) (setq z0 (+ (tbfiledata wslope offset ycorr) (* -1.0 offset) (* 0.0 (/ duct 2.0)))) (if (= count 0) (progn (setq llz (list z0)) ) (progn (setq ltemp llz) (setq llz (cons z0 ltemp)) ) ) (setq count (+ 1 count)) ) (setq llz (reverse llz)) (terpri) (setq llz llz) ) (defun tbdataz3 (FICHA llx0 / llx lly ang0 delta ss0 ss1 ss2 sl0 sl1 sn0 sn1 sn2 en0 en1 en2 p0 p1 dx dxacum dxtotal count x0 x1 x2 y0 y1 y2 ytext p2 p3 p20 p30 ptext dh txt0 ) (setq delta 100000.0) (setq ALT1 300.0) (setq count 0) (print "...PLAN VIEW select reference object......") (setq ss0 (ssget)) (terpri) (print "...select CG tendon......") (setq ss1 (ssget)) (terpri) (setq p0 (getpoint "..........First Point........")) (terpri) (setq p1 (getpoint p0 "..........Last Point........")) (terpri) (setq txt0 (getstring "..................")) (terpri) (setvar "osmode" 0) (setq sl0 (sslength ss0)) (setq sn0 (ssname ss0 (- sl0 1))) (setq en0 (entget sn0)) (setq sl1 (sslength ss1)) (setq sn1 (ssname ss1 (- sl1 1))) (setq en1 (entget sn1)) (setq dxtotal (distance p0 p1)) (setq x0 (car p0)) (setq x1 (car p1)) (setq y0 (min (cadr p0) (cadr p1))) (setq ang0 (angle p0 p1)) (setq p2 (polar p0 (+ ang0 (* 1.5 pi)) delta)) (setq p3 (polar p0 (+ ang0 (* 0.5 pi)) delta)) (setq dxacum 0.0) (repeat (length llx0) (setq p20 (tbinter sn0 p2 p3)) (setq p30 (tbinter sn1 p2 p3)) (setq dh (distance p20 p30)) (if (= dh delta) (progn (terpri) (print " xxx NO INTERSECTION OF TENDON WITH REFERENCE OBJECT....PLEASE CHECK FIRST/LAST POINT XXXX" ) (close FICHA) (QUIT) ) ) (if (= dxacum 0.0) (progn (setq lly (list dh)) ) (progn (setq ltemp lly) (setq lly (cons dh ltemp)) ) ) (setq count (+ 1 count)) (if (< count (length llx0)) (setq dx (abs (- (nth count llx0) (nth (- count 1) llx0)))) (setq dx dx) ) (setq dxacum (+ dxacum dx)) (setq p2 (polar p2 ang0 dx)) (setq p3 (polar p3 ang0 dx)) ) (setq lly (reverse lly)) (setvar "osmode" 15359) (setq lly lly) ) (defun tbdataalfa (lx ly lz / x0 y0 z0 x1 y1 z1 x2 y2 z2 nx ltemp count lalfa n0 n1 n2 alfa ) (setq nx (length lx)) (setq count 1) (setq lalfa (list 0.0)) (repeat (- nx 2) (setq n0 (- count 1)) (setq n1 (- count 0)) (setq n2 (+ count 1)) (setq x0 (nth n0 lx)) (setq x1 (nth n1 lx)) (setq x2 (nth n2 lx)) (setq y0 (nth n0 ly)) (setq y1 (nth n1 ly)) (setq y2 (nth n2 ly)) (setq z0 (nth n0 lz)) (setq z1 (nth n1 lz)) (setq z2 (nth n2 lZ)) (setq alfa (tbangle x0 y0 z0 x1 y1 z1 x2 y2 z2)) (setq ltemp lalfa) (setq lalfa (cons alfa ltemp)) (setq count (+ 1 count)) ) (setq ltemp lalfa) (setq lalfa (cons 0.0 ltemp)) (setq lalfa (reverse lalfa)) (setq lalfa lalfa) ) (defun acos (x) (cond ((equal x 1.0 5.0e- 0.0 ) ((equal x -1.0 5.0e- pi ) ((< (abs x) 1.0) (- (* pi 0.5) (atan x (sqrt (- 1.0 (* x x))) )) ) ) ) (defun tbdatalargo (lx ly lz / x0 y0 z0 x1 y1 z1 nx ltemp count llargo n0 n1 largo lacum ) (setq nx (length lx)) (setq count 1) (setq llargo (list 0.0)) (setq lacum 0.0) (repeat (- nx 1) (setq n0 (- count 1)) (setq n1 (- count 0)) (setq x0 (nth n0 lx)) (setq x1 (nth n1 lx)) (setq y0 (nth n0 ly)) (setq y1 (nth n1 ly)) (setq z0 (nth n0 lz)) (setq z1 (nth n1 lz)) (setq largo (tbdist x0 y0 z0 x1 y1 z1)) (setq lacum (+ lacum largo)) (setq llargo (cons lacum llargo)) (setq count (+ 1 count)) ) (setq llargo (reverse llargo)) (setq llargo llargo) ) (defun tbf0 (largo alfa mu k0 / l0 l1 alfa0 nx ltemp count llargo n0 n1 delta pacum ) (setq nx (length largo)) (setq count 1) (setq pacum 1.0) (setq lf0 (list 1.0)) (repeat (- nx 1) (setq n0 (- count 1)) (setq n1 (- count 0)) (setq l0 (nth n0 largo)) (setq l1 (nth n1 largo)) (setq alfa0 (nth n1 alfa)) (setq delta (exp (* -1.0 (+ (* 0.001 k0 (abs (- l1 l0))) (* mu alfa0)))) ) (setq pacum (* delta pacum)) (setq lf0 (cons pacum lf0)) (setq count (+ 1 count)) ) (setq lf0 (reverse lf0)) (setq lf0 lf0) ) (defun tbdelta (largo force EP sigma0 / ld0 l0 l1 f0 f1 nx ltemp count llargo n0 n1 delta dacum ) (setq nx (length largo)) (setq count 1) (setq dacum 0.0) (setq ld0 (list dacum)) (repeat (- nx 1) (setq n0 (- count 1)) (setq n1 (- count 0)) (setq l0 (nth n0 largo)) (setq l1 (nth n1 largo)) (setq f0 (nth n0 force)) (setq f1 (nth n1 force)) (setq delta (* (abs (- l0 l1)) (* 0.5 (+ f0 f1)) (/ sigma0 EP))) (setq dacum (+ delta dacum)) (setq ld0 (cons dacum ld0)) (setq count (+ 1 count)) ) (setq ld0 (reverse ld0)) (setq ld0 ld0) ) (defun tbext2 (largo force1 force2 delta1 delta2 EP sigma0 / p01 p02 p11 p12 elong1 elong2 x0 x1 x2 f2 f01 f02 f11 f12 nx ltemp count ld0 n0 n1 delta delta0 dacum ) (setq nx (length largo)) (setq count 1) (setq ld0 (list 0.0 0.0 0.0)) (repeat (- nx 1) (setq n0 (- count 1)) (setq n1 (- count 0)) (setq x0 (nth n0 largo)) (setq x1 (nth n1 largo)) (setq f01 (nth n0 force1)) (setq f02 (nth n1 force1)) (setq f11 (nth n0 force2)) (setq f12 (nth n1 force2)) (setq p01 (list x0 f01)) (setq p02 (list x1 f02)) (setq p11 (list x0 f11)) (setq p12 (list x1 f12)) (IF (INTERs p01 p02 p11 p12) (progn (setq x2 (car (INTERs p01 p02 p11 p12))) (setq f2 (cadr (INTERs p01 p02 p11 p12))) (setq delta (* (abs (- x0 x2)) (* 0.5 (+ f01 f2)) (/ sigma0 EP)) ) (setq delta (+ delta (nth n0 delta1))) (setq delta0 (* (abs (- x2 x1)) (* 0.5 (+ f12 f2)) (/ sigma0 EP)) ) (setq delta0 (+ delta0 (nth n1 delta2))) (setq ld0 (list x2 delta delta0 f2)) ) ) (setq count (+ 1 count)) ) (setq ld0 ld0) ) (defun rtosf (num space fix0 / temp cont cont1) (setq temp (rtos num 2 fix0)) (setq cont (strlen temp)) (setq cont1 (- space cont)) (repeat cont1 (setq temp (strcat " " temp)) ) (setq temp temp) ) (defun tbdata (/ title1 title2 title3 Ep fpu Ap Nstrand Fjack mu k Radio stressing ljack lista , ss sl sn en sn0 sn1 sn2 sn3 sn4 sn5 sn6 sn7 sn8 sn9 sn10 sn11 sn12 sn13 sn14 , en0 en1 en2 en3 en4 en5 en6 en7 en8 en9 en10 en11 en12 en13 en14 , let1 let2 let3 let4 let5 let6 let7 let8 let9 let10 let11 let12 let13 let14 ) (terpri) (print "...Select Block with Datas ....") (setq ss (ssget)) ;; Select entities (setq sl 1) ;; Get # ents selected (setq sn (ssname ss (- sl 1))) ;; Get entity name (setq en (entget sn)) ;; Get entity structure (if (= (cdr (assoc 2 en)) "DATA-CABLE") ;; If block entity (progn (setq sn0 (entnext sn)) (setq en0 (entget sn0)) (setq let1 (cdr (assoc 1 en0))) (setq sn1 (entnext sn0)) (setq en1 (entget sn1)) (setq let2 (cdr (assoc 1 en1))) (setq sn2 (entnext sn1)) (setq en2 (entget sn2)) (setq let3 (cdr (assoc 1 en2))) (setq sn3 (entnext sn2)) (setq en3 (entget sn3)) (setq let4 (atof (cdr (assoc 1 en3)))) (setq sn4 (entnext sn3)) (setq en4 (entget sn4)) (setq let5 (atof (cdr (assoc 1 en4)))) (setq sn5 (entnext sn4)) (setq en5 (entget sn5)) (setq let6 (atof (cdr (assoc 1 en5)))) (setq sn6 (entnext sn5)) (setq en6 (entget sn6)) (setq let7 (atof (cdr (assoc 1 en6)))) (setq sn7 (entnext sn6)) (setq en7 (entget sn7)) (setq let8 (atof (cdr (assoc 1 en7)))) (setq sn8 (entnext sn7)) (setq en8 (entget sn8)) (setq let9 (atof (cdr (assoc 1 en8)))) (setq sn9 (entnext sn8)) (setq en9 (entget sn9)) (setq let10 (atof (cdr (assoc 1 en9)))) (setq sn10 (entnext sn9)) (setq en10 (entget sn10)) (setq let11 (atof (cdr (assoc 1 en10)))) (setq sn11 (entnext sn10)) (setq en11 (entget sn11)) (setq let12 (atoi (cdr (assoc 1 en11)))) (setq sn12 (entnext sn11)) (setq en12 (entget sn12)) (setq let13 (atof (cdr (assoc 1 en12)))) (setq sn13 (entnext sn12)) (setq en13 (entget sn13)) (setq let14 (atof (cdr (assoc 1 en13)))) ) (PROGN (TERPRI) (PRINT "...WRONG BLOCK...SHALL BE DATA-CABLE...") (TERPRI) (QUIT) ) ) (setq lista (list let1 let2 let3 let4 let5 let6 let7 let8 let9 let10 let11 let12 let13 let14 ) ) (setq lista lista) ) (defun tbfill ( nelem value0 / ltemp count lista0) (setq lista0 ( list value0 )) (repeat (- nelem 1) (setq lista0 (cons value0 lista0)) ) ) (defun tbadd ( ll1 ll2 / ii ltemp count lista0 value0) (setq count (length ll1)) (if (not (= (length ll1) (length ll2))) (quit)) (setq ii 0) (setq value0 (+ (nth ii ll1) (nth ii ll2))) (setq lista0 (list value0)) (repeat (- count 1) (setq ii (+ 1 ii)) (setq value0 (+ (nth ii ll1) (nth ii ll2))) (setq lista0 (cons value0 lista0)) ) (setq lista0 (reverse lista0)) (setq lista0 lista0) ) (defun tbextension (/ cont title1 title2 title3 Ep fpu Ap Nstrand Fjack stressing ljack wslope let1 let2 let3 llxy llx lly llz llz1 llz2 llz3 Radio llalfa llargo lforce1 , lforce2 elong2 x0 y0 z0 largo0 alfa0 f0 f1 d0 d1 dj alfacum datas FICHA offset duct ctrlpv ) (SETVAR "CMDECHO" 0) (command "_ucs" "_w" ) (setq datas (tbdata)) (setq title1 (nth 0 datas)) (setq title2 (nth 1 datas)) (setq title3 (nth 2 datas)) (setq Ep (nth 3 datas)) (setq fpu (nth 4 datas)) (setq Ap (nth 5 datas)) (setq Nstrand (nth 6 datas)) (setq Fjack (nth 7 datas)) (setq mu (nth 8 datas)) (setq k (nth 9 datas)) (setq Radio (nth 10 datas)) (setq stressing (nth 11 datas)) (setq ljack (nth 12 datas)) (setq wslope (nth 13 datas)) (setq Ep (* Ep 1000.0)) (setq Radio (* Radio 1000.0)) (setq ftension (/ (* Fjack 1000.0) (* Nstrand Ap fpu))) (setq f0 (* fpu ftension)) (terpri) (setq let1 (getvar "dwgprefix")) (setq let2 (getstring T "Output file name : ")) (setq let3 (strcat let1 let2 ".prn")) (SETQ FICHA (OPEN let3 "w")) (terpri) (setq offset (getreal "Offset of duct : ")) (terpri) (if offset (setq duct (getreal "Diameter of duct : ")) (setq duct nil)) (terpri) ; (setq ctrlpv T) (setq ctrlpv (getstring ".........PLAN VIEW : Y/N....")) (if (or (= ctrlpv "n") (= ctrlpv "N")) (setq ctrlpv nil) (setq ctrlpv T)) (terpri) ;(setq offset 93) ; (setq duct 102) (setq let2 " ") (write-line let2 FICHA) (setq let2 " VSL MIDDLE EAST LLC") (write-line let2 FICHA) (setq let2 " ") (write-line let2 FICHA) (setq let2 " EXTENSION CALCULATION ") (write-line let2 FICHA) (setq let2 " ") (write-line let2 FICHA) (write-line let2 FICHA) (setq let2 "PROJECT : ") (SETQ let2 (strcat let2 title1)) (write-line let2 FICHA) (setq let2 "STRUCTURE : ") (SETQ let2 (strcat let2 title2)) (write-line let2 FICHA) (setq let2 "TENDON REF : ") (SETQ let2 (strcat let2 title3)) (write-line let2 FICHA) (setq let2 "Horiz Radius: ") (if ctrlpv (SETQ let2 (strcat let2 "Measured from plan view")) (if (= Radio 0.0) (SETQ let2 (strcat let2 "Straight")) (SETQ let2 (strcat let2 (rtos (/ Radio 1000.0) 2 1) " m"))) ) (write-line let2 FICHA) (setq let2 "Web Slope : 1/") (SETQ let2 (strcat let2 (rtos wslope 2 2) " ")) (write-line let2 FICHA) (setq let2 " ") (write-line let2 FICHA) (setq let2 " ") (write-line let2 FICHA) (setq let2 "Steel References ") (write-line let2 FICHA) (setq let2 " Ultimate Tensile Strength F's = ") (SETQ let2 (strcat let2 (RTOS fpu 2 0) " MPa")) (write-line let2 FICHA) (setq let2 " Young Modulus Ep = ") (SETQ let2 (strcat let2 (RTOS (/ Ep 1000) 2 1) " KN/mm2")) (write-line let2 FICHA) (setq let2 " Area Strand As = ") (SETQ let2 (strcat let2 (RTOS Ap 2 0) " mm2")) (write-line let2 FICHA) (setq let2 " Number of Strand N = ") (SETQ let2 (strcat let2 (RTOS Nstrand 2 0) " nos")) (write-line let2 FICHA) (setq let2 " Tendon Force Pj = ") (SETQ let2 (strcat let2 (RTOS Fjack 2 1) " kN")) (write-line let2 FICHA) (setq let2 " Stressing Force sj = ") (SETQ let2 (strcat let2 (RTOS ftension 2 2) " x fpu")) (write-line let2 FICHA) (setq let2 " Length Jack Lj = ") (SETQ let2 (strcat let2 (RTOS ljack 2 1) " mm")) (write-line let2 FICHA) (setq let2 " Stressing Operation = ") (IF (= stressing 3) (SETQ let2 (strcat let2 (RTOS 2 2 1) " 2 sides not simoultanesly")) (SETQ let2 (strcat let2 (RTOS stressing 2 1) " side")) ) (write-line let2 FICHA) (setq let2 " ") (write-line let2 FICHA) (setq let2 "Friction Constants ") (write-line let2 FICHA) (setq let2 " Curvature Coefficient u = ") (SETQ let2 (strcat let2 (RTOS mu 2 5) " /radian")) (write-line let2 FICHA) (setq let2 " Wobble Coefficient k = ") (SETQ let2 (strcat let2 (RTOS k 2 5) " /m")) (write-line let2 FICHA) (IF (AND OFFSET DUCT) (PROGN (setq let2 " ") (write-line let2 FICHA) (write-line let2 FICHA) (setq let2 " Offset Web-Duct Offset = ") (SETQ let2 (strcat let2 (RTOS offset 2 0) " mm")) (write-line let2 FICHA) (setq let2 " Duct Diameter Ddiam = ") (SETQ let2 (strcat let2 (RTOS duct 2 0) " mm")) (write-line let2 FICHA) )) (setq let2 " ") (write-line let2 FICHA) (write-line let2 FICHA) (write-line let2 FICHA) (setq let2 " X(mm) Y(mm) Zh(mm) Zw(mm) ZT(mm) Length(mm) Alfa(rad) P1/Pj Delta1(mm)" ) (if (= stressing 2) (progn (setq let3 " P2/Pj Delta2(mm)") (setq let2 (strcat let2 let3)) ) ) (write-line let2 FICHA) (setq llxy (tbdataxy FICHA)) (setq llx (car llxy)) (setq lly (cadr llxy)) (if (= Radio 0.0) (SETQ llz1 (tbfill (length llx) 0.0)) (setq llz1 (tbdataz1 llx lly Radio)) ) (if (and offset duct) (setq llz2 (tbdataz2 llx lly wslope offset duct)) (SETQ llz2 (tbfill (length llx) 0.0)) ) (SETQ llz3 (tbfill (length llx) 0.0)) (if ctrlpv (if (= Radio 0.0) (setq llz1 (cadr (tbdataxy FICHA))) (setq llz1 (tbz3 llx))) ) ;(print llz1) (print llz2) (print llz3) ; (print (length llz1)) (print (length llz2)) (print (length llz3)) ; (print (length llx)) (print (length lly)) (print (length llz1)) (print (length llz2)) (print (length llz3)) ; (print llx) (print lly) (print llz1) (print llz2) (print llz3) (setq llz (tbadd (tbadd llz1 llz2 ) llz3 )) ; (print llz) (setq llalfa (tbdataalfa llx lly llz)) (setq llargo (tbdatalargo llx lly (tbadd llz2 llz3 ) )) ;(print " 2 QUAIS>>> VSL") ; (PRINT tbf0) (print llargo) (print llalfa) (print mu) (print k) (setq lforce1 (tbf0 llargo llalfa mu k)) ;(print " 3 QUAIS>>> VSL") (setq lforce2 (reverse (tbf0 (reverse llargo) (reverse llalfa) mu k))) ;(print " 4 QUAIS>>> VSL") (setq delta1 (tbdelta llargo lforce1 Ep f0)) (setq delta2 (reverse (tbdelta (reverse llargo) (reverse lforce2) Ep f0)) ) (setq elong2 (tbext2 llargo lforce1 lforce2 delta1 delta2 Ep f0)) (setq cont 0) (setq alfacum 0.0) (repeat (length llargo) (setq x0 (nth cont llx)) (setq y0 (nth cont lly)) (setq z0 (nth cont llz)) (setq z1 (nth cont llz1)) (setq z2 (nth cont llz2)) (setq z3 (nth cont llz3)) (setq largo0 (nth cont llargo)) (setq alfa0 (nth cont llalfa)) (setq d0 (nth cont delta1)) (setq d1 (nth cont delta2)) (setq f0 (nth cont lforce1)) (setq f1 (nth cont lforce2)) ; (setq let2 (strcat (rtosf x0 12 0) (rtosf y0 12 0) (rtosf z0 12 0) (rtosf largo0 12 1) (rtosf alfa0 12 2) (rtosf f0 12 3) (rtosf d0 12 1))) (setq let2 (strcat (rtosf x0 12 0) (rtosf y0 12 0) (rtosf z1 12 0) (rtosf z2 12 0) ; (rtosf z3 12 0) (rtosf z0 12 0) (rtosf largo0 12 1) (rtosf alfa0 12 3) (rtosf f0 12 3) (rtosf d0 12 1) ) ) (if (= stressing 2) (progn (setq let1 (strcat (rtosf f1 12 3) (rtosf d1 12 1))) (setq let2 (strcat let2 let1)) ) ) (write-line let2 FICHA) (setq alfacum (+ alfa0 alfacum)) (setq cont (+ 1 cont)) ) (setq let2 " ") (write-line let2 FICHA) (write-line let2 FICHA) (setq let2 (strcat "Total Length = " (rtosf largo0 12 1) " mm")) (write-line let2 FICHA) (setq let2 (strcat "Total Angle = " (rtosf alfacum 12 2) " rad")) (write-line let2 FICHA) (if (= stressing 2) (progn (setq let2 (strcat "Length (P1=P2) = " (rtosf (nth 0 elong2) 12 1) " mm" ) ) (write-line let2 FICHA) (setq let2 (strcat "Extension 1 = " (rtosf (nth 1 elong2) 12 1) " mm" ) ) (write-line let2 FICHA) (setq let2 (strcat "Extension 2 = " (rtosf (nth 2 elong2) 12 1) " mm" ) ) (write-line let2 FICHA) ) (progn (setq let2 (strcat "Extension 1 = " (rtosf d0 12 1) " mm")) (write-line let2 FICHA) (if (= stressing 3) (write-line (strcat "Topping up = " (rtosf (+ (nth 1 elong2) (nth 2 elong2) (* -1.0 d0)) 12 1) " mm") FICHA) ) ) ) (setq dj (/ (* 1.02 Fjack ljack 1000.0) (* Ap Ep Nstrand))) (setq let2 (strcat "Extension Jack = " (rtosf dj 12 1) " mm")) (write-line let2 FICHA) (close FICHA) (SETVAR "CMDECHO" 1) (terpri) (print "........END OF PROGRAM......") (TERPRI) ) (defun tbfiledata (slope offset yvalue / data yvalue1 yvalue2 offset1 offset2 FICHA ncont ncont0 ncont1 ncont2 ncont3 ctrl cad0 cad1 cad2 cad3 cad4 let1 let2 let3 ) (setq ctrl T) (setq ncont (setq ncont0 1) (setq ncont1 (+ ncont0 ncont)) (setq ncont2 (+ ncont1 ncont)) (setq ncont3 (+ ncont2 ncont)) (setq yvalue1 0.0) (setq yvalue2 0.0) (setq offset1 0.0) (setq offset2 0.0) (setq let1 (getvar "dwgprefix")) (setq let2 "zvalue") (setq let3 (strcat let1 let2 ".prn")) (SETQ FICHA (OPEN let3 "r")) (SETQ CAD0 (READ-LINE FICHA)) (WHILE CTRL (IF (SETQ CAD0 (READ-LINE FICHA)) (PROGN (SETQ CAD1 (atof (SUBSTR CAD0 ncont0 ncont))) (SETQ CAD2 (atof (SUBSTR CAD0 ncont1 ncont))) (SETQ CAD3 (atof (SUBSTR CAD0 ncont2 ncont))) (SETQ CAD4 (atof (SUBSTR CAD0 ncont3 ncont))) (if (and (= cad1 slope) (= cad2 offset)) (if (not (> cad3 yvalue)) (progn (setq yvalue1 cad3) (setq offset1 cad4) ) ) ) (if (and (= cad1 slope) (= cad2 offset)) (if (and (= yvalue2 0.0) (not (< cad3 yvalue))) (progn (setq yvalue2 cad3) (setq offset2 cad4) ) ) ) (SETQ CTRL T) ) (PROGN (SETQ CTRL NIL) ) ) ) (close FICHA) (if (or (= offset1 0.0) (= offset2 0.0)) (setq data offset) (if (= offset1 offset2) (SETQ data offset1) (setq data (+ offset1 (* (/ (- yvalue yvalue1) (- yvalue2 yvalue1)) (- offset2 offset1) ) ) ) ) ) (setq data (atoi (rtos data 2 0))) ) (defun tbz3 ( llx0 / number tol list1 count count1 ctrl ang ang1 ang2 dh dh1 p0 p10 pini pfin pref p1 p2 p3 p4 p5 ss1 s1 s2 s3 en1 en2 en3 radio yref ) (setq tol 0.001) ; (print "...Delta H...") ; (setq dh (getreal)) (setq dh (abs (- (nth 1 llx0) (nth 0 llx0)))) (setq number 20.0) (setq dh1 (/ dh number)) (terpri) (print "......PLAN VIEW.......") (print "...select cg tendon....") (setq ss1 (ssget)) (terpri) (print "...first point....") (setq pini (getpoint)) (terpri) (print "...last point....") (setq pfin (getpoint)) (terpri) (print "...reference point....") (setq pref (getpoint)) (terpri) (setq yref (nth 1 pref)) (setvar "osmode" 0) (setvar "cmdecho" 0) (setq s1 (ssname ss1 0)) (setq en1 (entget s1)) (setq p1 pini) (setq p2 pfin) (setq count 0) (setq count1 0) (setq ctrl T) (setq list1 (list (- (nth 1 p1) yref) )) (setq ang (angle p1 p2)) (while ctrl (setq ang1 (- ang (/ pi 2 ))) (setq ang2 (+ ang (/ pi 2 ))) (if (< ang1 0.0) (setq ang1 (+ ang1 (* 2.0 pi)))) (if (< ang2 0.0) (setq ang2 (+ ang2 (* 2.0 pi)))) (setq p0 (polar p1 ang1 dh1)) (setq p10 (polar p1 ang2 dh1)) (command "arc" "c" p1 p0 p10 ) (setq s2 (entlast)) (setq en2 (entget s2)) (command "trim" s1 "" s2 "") (setq s3 (entlast)) (setq en3 (entget s3)) (setq ang3 (cdr (assoc 50 en3))) (setq ang4 (cdr (assoc 51 en3))) (if (or (= (length list1) (- (length llx0 ) 1)) (and (or (> tol (abs (- ang3 ang1)) ) (> tol (abs (- ang3 ang2)))) (or (> tol (abs (- ang4 ang1)) ) (> tol (abs (- ang4 ang2)))) ) ) (progn (setq ctrl nil) (setq p3 pfin) (setq count (- number 1)) ) (progn (setq ctrl T) (if (or (> tol (abs (- ang3 ang1)) ) (> tol (abs (- ang3 ang2)) )) (setq p3 (polar p1 ang4 dh1)) (setq p3 (polar p1 ang3 dh1)) ) )) (command "erase" s3 "") (setq count (+ 1 count)) (if (= (fix (/ count number)) (/ count number)) (progn (setq count1 (+ 1 count1)) (setq list1 (cons (- (nth 1 p3) yref) list1)) )) (setq ang (angle p1 p3)) (setq p1 p3) ) (setq list1 (reverse list1)) ) (defun tbrecess ( / cont largo largo1 datas factorx factory title1 bw1 bw2 h1 h2 alfaa alfav alfah depth alfai alfa alfa1 alfa2 alfa3 x0 x1 y0 y1 z1 z2 z3 zvalue txt0 txt1 p0 p01 p1 p2 p3 p4 p5 p6 p7 p8 alt1 ptext scale s1 s2 s3 s4 s5 s6 aux0 aux1 aux2 aux3 aux4 aux5 aux6 beta1 beta2 v1 v2 v3 w1 w2 w3 u1 u2 u3 listw listh hvalue wvalue ) (SETVAR "CMDECHO" 0) (command "_ucs" "_w" ) (setvar "plinetype" 0) (setq ALT1 50) (setq scale 1) ; (setq alfa (list 45 135 225 315 )) (terpri) (SETQ p0 (getpoint "center point of anchorage")) (terpri) (SETQ p01 (getpoint p0 "center point at the top of anchorage")) (setq alfaa (/ (* 180.0 (angle p0 p01)) pi )) (setq alfaa (- 90.0 alfaa )) (setq x0 (nth 0 p0)) (setq y0 (nth 1 p0)) (setq datas (tbdata2)) (setq title1 (nth 0 datas)) (setq bw1 (nth 1 datas)) (setq bw2 (nth 2 datas)) (setq h1 (nth 3 datas)) (setq h2 (nth 4 datas)) ; (setq alfaa (nth 5 datas)) (setq alfav (* -1.0 (nth 5 datas))) (setq alfah (* -1.0 (nth 6 datas))) ;(print alfav ) (print alfah) (setq depth (nth 7 datas)) (setq alfai (nth 8 datas)) (setq alfa (list (/ (* 180 (atan (/ h1 bw2))) pi) (- 180 (/ (* 180 (atan (/ h1 bw1))) pi)) (+ 180 (/ (* 180 (atan (/ h2 bw1))) pi)) (- 360 (/ (* 180 (atan (/ h2 bw2))) pi)) )) (setq largo (list (sqrt (+ (* h1 h1) (* bw2 bw2))) (sqrt (+ (* h1 h1) (* bw1 bw1))) (sqrt (+ (* h2 h2) (* bw1 bw1))) (sqrt (+ (* h2 h2) (* bw2 bw2))) )) (setq listh (list h1 h1 h2 h2)) (setq listw (list bw2 bw1 bw1 bw2)) ; (print datas) (print alfa) (print largo) (setq u1 (* 1000 (sin (/ (* alfah pi ) 180.0)))) (setq u2 (* 1000 (cos (/ (* alfah pi ) 180.0)))) (setq u3 (/ (* -1.0 u2 (sin (/ (* alfav pi ) 180.0))) (cos (/ (* alfav pi ) 180.0)))) (setq aux0 (sqrt (+ (* u1 u1) (* u2 u2) (* u3 u3)))) (setq u1 (/ u1 aux0)) (setq u2 (/ u2 aux0)) (setq u3 (/ u3 aux0)) (setq v1 (* 1000 (sin (/ (* alfaa pi ) 180.0)))) (setq v2 0.0) (setq v3 (* 1000 (cos (/ (* alfaa pi ) 180.0)))) (setq aux0 (sqrt (+ (* v1 v1) (* v2 v2) (* v3 v3)))) (setq v1 (/ v1 aux0)) (setq v2 (/ v2 aux0)) (setq v3 (/ v3 aux0)) (setq w1 (* 1000 (sin (/ (* (+ 90.0 alfaa) pi ) 180.0)))) (setq w2 0.0) (setq w3 (* 1000 (cos (/ (* (+ 90.0 alfaa) pi ) 180.0)))) (setq aux0 (sqrt (+ (* w1 w1) (* w2 w2) (* w3 w3)))) (setq w1 (/ w1 aux0)) (setq w2 (/ w2 aux0)) (setq w3 (/ w3 aux0)) (setq aux1 (- (* u2 v3) (* v2 u3))) (setq aux2 (- (* v1 u3) (* u1 v3))) (setq aux3 (- (* u1 v2) (* v1 u2))) (setq aux0 (sqrt (+ (* aux1 aux1) (* aux2 aux2) (* aux3 aux3)))) (setq aux1 (/ aux1 aux0)) (setq aux2 (/ aux2 aux0)) (setq aux3 (/ aux3 aux0)) (setq aux4 (- (* u2 aux3) (* aux2 u3) )) (setq aux5 (- (* aux1 u3) (* u1 aux3) )) (setq aux6 (- (* u1 aux2) (* aux1 u2) )) (setq aux0 (sqrt (+ (* aux4 aux4) (* aux5 aux5) (* aux6 aux6)))) (setq aux4 (/ aux4 aux0)) (setq aux5 (/ aux5 aux0)) (setq aux6 (/ aux6 aux0)) (setq beta1 (tbangle w1 w2 w3 0.0 0.0 0.0 aux1 aux2 aux3)) (setq beta2 (tbangle v1 v2 v3 0.0 0.0 0.0 aux4 aux5 aux6)) (setq aux0 (/ (/ (sin beta1) (cos beta1)) (cos beta2) )) (setq beta1 (/ (sin beta2) (cos beta2) )) (setq beta2 aux0) ; (print (list u1 u2 u3 v1 v2 v3 w1 w2 w3)) ; (print (list aux1 aux2 aux3 aux4 aux5 aux6)) ; (print (list beta1 beta2)) (setvar "osmode" 0) (setq cont 0) (repeat 4 (setq alfa1 (- (nth cont alfa) alfaa)) (setq largo1 (nth cont largo)) (setq hvalue (nth cont listh)) (setq wvalue (nth cont listw)) (setq x1 (* largo1 (cos (/ (* pi alfa1 ) 180.0)))) (setq y1 (* largo1 (sin (/ (* pi alfa1 ) 180.0)))) (if (> y1 0.0) (setq factorx 1.0) (setq factorx -1.0)) (if (> x1 0.0) (setq factory 1.0) (setq factory -1.0)) (setq z1 (* factorx hvalue beta1 (/ aux5 (abs aux5)) ) ) (setq z2 (* factory wvalue beta2 (/ aux2 (abs aux2)) ) ) ; (PRINT (LIST factorx hvalue beta1 (/ aux5 (abs aux5)) Z1 ) ) ; (PRINT (LIST factory wvalue beta2 (/ aux2 (abs aux2)) Z2 ) ) (setq z3 (+ z1 z2)) (setq temp (list x1 y1 z1 z2 z3)) (print temp) (setq ptext (list (+ x0 x1) (+ y0 y1))) (if (= cont 0) (setq zvalue (list (list x1 y1 z3 ptext))) (setq zvalue (append zvalue (list (list x1 y1 z3 ptext ))))) (if (> cont 1) (setq txt0 "TC") (setq txt0 "BC")) (setq txt1 (strcat "(" (rtos (abs x1) 2 0) "," (rtos (abs y1) 2 0) "," (rtos z3 2 0) ")") ) (command "_TEXT" "J" txt0 ptext ALT1 0.0 txt1 ) (setq cont (+ 1 cont)) ) (setq p1 (nth 3 (nth 0 zvalue))) (setq p2 (nth 3 (nth 1 zvalue))) (setq p3 (nth 3 (nth 2 zvalue))) (setq p4 (nth 3 (nth 3 zvalue))) (setq p5 (polar p1 (+ (angle p1 p2) (* pi 0.25)) (* -1.0 (nth 2 (nth 0 zvalue)) scale))) (setq p6 (polar p2 (+ (angle p1 p2) (* pi 0.25)) (* -1.0 (nth 2 (nth 1 zvalue)) scale))) (setq p7 (polar p3 (+ (angle p4 p3) (* pi 0.25)) (* -1.0 (nth 2 (nth 2 zvalue)) scale))) (setq p8 (polar p4 (+ (angle p4 p3) (* pi 0.25)) (* -1.0 (nth 2 (nth 3 zvalue)) scale))) (command "pline" p1 p5 p8 p4 p1 "") ;(command "region" (entlast) "") (setq s1 (entlast)) (command "pline" p2 p6 p7 p3 p2 "") ;(command "region" (entlast) "") (setq s2 (entlast)) (command "pline" p1 p2 p3 p4 p1 "") ;(command "region" (entlast) "") (setq s3 (entlast)) (command "pline" p5 p6 p7 p8 p5 "") ;(command "region" (entlast) "") (setq s4 (entlast)) ; (command "union" s1 s2 s3 s4 "") (terpri) (print "........END OF PROGRAM......") (TERPRI) ) (defun tbdata2 (/ title1 title2 title3 Ep fpu Ap Nstrand Fjack mu k Radio stressing ljack lista , ss sl sn en sn0 sn1 sn2 sn3 sn4 sn5 sn6 sn7 sn8 sn9 sn10 sn11 sn12 sn13 sn14 , en0 en1 en2 en3 en4 en5 en6 en7 en8 en9 en10 en11 en12 en13 en14 , let1 let2 let3 let4 let5 let6 let7 let8 let9 let10 let11 let12 let13 let14 ) (terpri) (print "...Select Block with Datas ....") (setq ss (ssget)) (setq sl 1) (setq sn (ssname ss (- sl 1))) (setq en (entget sn)) (if (= (cdr (assoc 2 en)) "RECESS-DATA") (progn (setq sn0 (entnext sn)) (setq en0 (entget sn0)) (setq let1 (cdr (assoc 1 en0))) (setq sn1 (entnext sn0)) (setq en1 (entget sn1)) (setq let2 (atof (cdr (assoc 1 en1)))) (setq sn2 (entnext sn1)) (setq en2 (entget sn2)) (setq let3 (atof (cdr (assoc 1 en2)))) (setq sn3 (entnext sn2)) (setq en3 (entget sn3)) (setq let4 (atof (cdr (assoc 1 en3)))) (setq sn4 (entnext sn3)) (setq en4 (entget sn4)) (setq let5 (atof (cdr (assoc 1 en4)))) (setq sn5 (entnext sn4)) (setq en5 (entget sn5)) (setq let6 (atof (cdr (assoc 1 en5)))) (setq sn6 (entnext sn5)) (setq en6 (entget sn6)) (setq let7 (atof (cdr (assoc 1 en6)))) (setq sn7 (entnext sn6)) (setq en7 (entget sn7)) (setq let8 (atof (cdr (assoc 1 en7)))) (setq sn8 (entnext sn7)) (setq en8 (entget sn8)) (setq let9 (atof (cdr (assoc 1 en8)))) ) (PROGN (TERPRI) (PRINT "...WRONG BLOCK...SHALL BE DATA-CABLE...") (TERPRI) (QUIT) ) ) (setq lista (list let1 let2 let3 let4 let5 let6 let7 let8 let9 ) ) (setq lista lista) ) toolb_5h.lsp