วันอาทิตย์ที่ 8 พฤศจิกายน พ.ศ. 2563

Simple Curve

 

;;-------------Start Copy--------------------

;|

      Create and Design by AutolispTH November 2020

      Contact AutolispTH@hotmail.com

      - Select Sinlge curve or Multi curve

      - Pick Position the data table

|;

(vl-load-com)

(defun c:spc ( / ss ctr obj )

(setq old_cmdecho  (getvar "cmdecho"))  ;  cmdecho

(setq old_osnap (getvar "osmode"))  ; osnap

(setq old_layer (getvar "clayer")) ;  layer

(setvar "cmdecho" 0)    ;  (off) cmdecho

(setvar "osmode" 0)

      (if (not (tblsearch "LAYER" "Simple_Curve"));;<=== Layer Name

            (command "._layer" "_M" "Simple_Curve" "_Color" "2" "" "LType" "Continuous" "" "");;<=== Layer Name

      )

      (if (not (tblsearch "LAYER" "Simple_Curve_Data"));;<=== Layer Name

            (command "._layer" "_M" "Simple_Curve_Data" "_Color" "3" "" "LType" "Continuous" "" "");;<=== Layer Name

      )

(princ "\n Select Simple Curve")   

(if (setq ss (ssget '((0 . "ARC"))))

      (progn

            (setq ctr 0)

            (repeat (sslength ss)

                  (setq obj (vlax-ename->vla-object (ssname ss ctr)))               

                  (setq ce (vlax-get obj 'center))

                  (setq sp (vlax-get obj 'startpoint))

                  (setq ep (vlax-get obj 'endpoint))

                  (setq len (vlax-get obj 'arcLength ))

                  (setq rad (vlax-get obj 'radius))

                  (setq dd (/ 5729.58 rad))

                  (setq ad (dms dd))

                  (setq ang (cvunit (vlax-get obj 'totalAngle)"radians" "degrees"));ANG

                  (setq aa (dms ang))

                  (setq lc (*(* 2.0 rad)(sin (dtor(/ ang 2.0)))))     ;C

                  (setq lt (* rad (tan (dtor(/ ang 2.0)))))          ;T

                  (setq lm (* (/ lc 2.0)(tan (dtor(/ ang 4.0)))))    ;M

                  (setq le (* lt(tan (dtor(/ ang 4.0)))))                  ;E

                  (setq pc (polar sp (angle sp ep) (/ lc 2.0)))

                  (setq p1 (polar ce (angle ce pc) (+ rad le)))

                  (setvar "clayer" "Simple_Curve")

                  (command "_pline" sp ce ep p1 "c")

                  (command "_pline" sp ep "")

                  (princ)

                  (setq ctr (1+ ctr))

                  (data)

            );repeat

      )

);if ss

;(princ (strcat "\n \U+0394 = " aa "\n D = " ad))

(setvar "cmdecho" old_cmdecho)  ; old_cmdecho

(setvar "osmode" old_osnap) ; old_osnap

(setvar "clayer" old_layer) ; old_layer

(princ)

);defun

(prompt "\nEnter SPC to Start Simple Curve.")

(defun data ()

      (setq txth 2.5    ;Text Height

              dec 3           ;Number Decimal

              styl (getvar "TEXTSTYLE")

      )

      (setq pt (getpoint "\n Pick Data Table Point :"))

;;-------------table points--------------

      (setq pta (list (+(car pt)(* txth 45))(cadr pt))

              pt1 (list (car pt)(-(cadr pt)(* txth 4)))

              pt1a (list (+(car pt1)(* txth 45))(cadr pt1))

              pt2 (list (car pt1)(-(cadr pt1)(* txth 8)))

              pt2a (list (+(car pt2)(* txth 45))(cadr pt2))

              pt3 (list (car pt2)(-(cadr pt2)(* txth 4)))

              pt3a (list (+(car pt3)(* txth 45))(cadr pt3))

              pt4 (list (+(car pt)(* txth 22))(cadr pt))

              pt4a (list (car pt4)(-(cadr pt4)(* txth 4)))

      )

;;-------------Text Points----------------

      (setq ptxt1 (list (+(car pt)txth)(-(cadr pt)(* txth 2.5)))

              ptxt2 (list (+(car pt4)txth)(-(cadr pt4)(* txth 1.75)))

              ptxt3 (list (car ptxt2)(-(cadr ptxt2)(* txth 1.5)))

              ptxt4 (list (+(car pt1)txth)(-(cadr pt1)(* txth 1.75)));;new row

              ptxt5 (list (car ptxt4)(-(cadr ptxt4)(* txth 1.5)))

              ptxt6 (list (car ptxt5)(-(cadr ptxt5)(* txth 1.5)))

              ptxt7 (list (car ptxt6)(-(cadr ptxt6)(* txth 1.5)))

              ptxt8 (list (car ptxt7)(-(cadr ptxt7)(* txth 1.5)))

      )

      (setq ptxt9 (list (+(car pt4a)txth)(-(cadr pt4a)(* txth 1.75)));;new row

              ptxt10 (list (car ptxt9)(-(cadr ptxt9)(* txth 1.5)))

              ptxt11 (list (car ptxt10)(-(cadr ptxt10)(* txth 1.5)))

              ptxt12 (list (car ptxt11)(-(cadr ptxt11)(* txth 1.5)))

              ptxt13 (list (car ptxt12)(-(cadr ptxt12)(* txth 1.5)))

              angt (/ (* (angle pt pta) 180) pi)

      )

      (setvar "clayer" "Simple_Curve_Data")

      (command "_text" "_j" "bl" ptxt1 txth angt "P.I.    STA.");;text1

      (command "_text" "_j" "bl" ptxt2 txth angt (strcat "N = " (countn(cadr p1))));;text2 N

      (command "_text" "_j" "bl" ptxt3 txth angt (strcat "E = " (countn(car p1))));;text3 E

      (command "_text" "_j" "bl" ptxt4 txth angt (strcat "\U+0394 = " aa));;text4 Delta

      (command "_text" "_j" "bl" ptxt5 txth angt (strcat "D = " ad));;text5 D

      (command "_text" "_j" "bl" ptxt6 txth angt (strcat "R = " (rtos rad 2 dec)" M."));;text6 R

      (command "_text" "_j" "bl" ptxt7 txth angt (strcat "T = " (rtos lt 2 dec) " M."));;text7 T

      (command "_text" "_j" "bl" ptxt8 txth angt (strcat "L = " (rtos len 2 dec)" M."));;text8 L

      (command "_text" "_j" "bl" ptxt9 txth angt (strcat "E = " (rtos le 2 dec) " M."));;text9 E

      (command "_text" "_j" "bl" ptxt10 txth angt (strcat "V = " "    K.P.H."));;text9 E

      (command "_text" "_j" "bl" ptxt11 txth angt (strcat "S.E. = " "    M/M"));;text9 E

      (command "_text" "_j" "bl" ptxt12 txth angt (strcat "Ts. = " "    M."));;text9 E

      (command "_text" "_j" "bl" ptxt13 txth angt (strcat "W = " "    M."));;text9 E

      (command "_pline" pt pta pt3a pt3 "c")

      (command "_pline" pt1 pt1a "")

      (command "_pline" pt2 pt2a "")

      (command "_pline" pt4 pt4a "")

)

;;---------------------------------

(defun tan (x)

    (/ (sin x)(cos x))

)

(defun arsin (x)

    (setq y (sqrt (- 1 (* x x))))

    (atan x y)

)

(defun arcos (x)

    (- (/ pi 2)(arsin x))

)

(defun rtod (x)

    (/ (* x 180) pi)

)

(defun dtor (x)

    (* x (/ pi 180))

)

;-----------------------------------

(defun DMS (ang) ;;degrees minutes seconds (ang=degrees)

      (setq angA (angtos (* ang (/ pi 180)) 1 3)

              na (strlen anga)

      )

      (setq aa (strcat (SUBSTR anga 1 2) "\U+00B0-"

                               (SUBSTR anga 4 2)"'-"

                               (SUBSTR anga 7 (- na 7)) "''"

                   )

      )

)

(defun countn (numx /);;100000.000 ==> 100,000.000

      (setq num (rtos numx 2 3))

      (setq tnum

            (cond ((< (read num) 1000) (strcat (SUBSTR num 1 3)));;100

                    ((and (>= (read num)  1000)(<(read num)  10000))  (strcat (SUBSTR num 1 1) "," (SUBSTR num 2 )));;1,000.000(SUBSTR num 5 4)

                    ((and (>= (read num)  10000)(<(read num)  100000)) (strcat (SUBSTR num 1 2) "," (SUBSTR num 3 )));;10,000.000(SUBSTR num 6 4)

                    ((and(>= (read num)  100000)(<(read num)  1000000)) (strcat (SUBSTR num 1 3) "," (SUBSTR num 4 )));;100,000.000(SUBSTR num 7 4)

                    ((and(>= (read num)  1000000)(<(read num)  10000000))(strcat (SUBSTR num 1 1) "," (SUBSTR num 2 3) "," (SUBSTR num 5 )));;1,000,000.000(SUBSTR num 8 4)

                    ((and(>= (read num)  10000000)(<(read num)  100000000))(strcat (SUBSTR num 1 2) "," (SUBSTR num 3 3) "," (SUBSTR num 6 )));;10,000,000(SUBSTR num 9 4)

                    ((and(>= (read num)  100000000)(<(read num)  1000000000))(strcat (SUBSTR num 1 3) "," (SUBSTR num 4 3) "," (SUBSTR num 7 )));;100,000,000.000(SUBSTR num 10 4)

            );cond

      );setq

      ;(setq cnum (atof tnum))

)

;;----------------End Copy---------------------

ไม่มีความคิดเห็น:

แสดงความคิดเห็น