Import CSV File CADTHAI & AutoCAD

 

;|

       - Import Coordinate X Y from .CSV Excel File.

       - Create by Songkhran Jongkul September 2021

       - Contact : https://www.facebook.com/groups/AutolispTH

|;

(defun c:imcsv (/ lst)

(setq old_cmdecho  (getvar "cmdecho"))

(setq old_osnap (getvar "osmode"))

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

(defun Deconstruct_String (st delimiter / p l)

       (while (setq p (vl-string-search delimiter st 0))

              (setq l  (cons (substr st 1 p) l)

                       st (substr st (+ p 2) (strlen st))

              )

       )

       (if st (setq l (cons st l)))

       (setq l (reverse l))

)

(setvar "cmdecho" 0)

(setvar "osmode" 0)

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

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

)

(if (setq file (getfiled "Select .CSV Excel file ..." "" "csv" 16))

       (progn       

              (setq file (open file "r"))

              (while (setq st (read-line file))

                     (setq st (Deconstruct_String st ";"))

                     (setq p (Deconstruct_String (car st) ","))

                     (setq xy (list (read (car p))(read (cadr p))))

                     (setq lst (append lst (list xy)))

              )

              (close file)

              (setvar "clayer" "pline_csv")

              (command "_pline" )

              (foreach x lst

                     (command x)

              )

              (command "")

              (command "_zoom" "_E")

              (setvar "clayer" old_layer)

       )

)

(setq mylst lst)     

(princ)

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(setvar "clayer" old_layer)  

(princ)

)

(prompt "\nCreate by Songkhran Jongkul September 2021")

(prompt "\nContact : https://www.facebook.com/groups/AutolispTH")

(prompt "\nEnter IMCSV to start Import Coordinate X Y from .CSV Excel File. ")

Hole Chart for CADTHAI & AutoCAD

 

;|

        - Update Text height and TextStyle

- Hole Chart for CADTHAI and AutoCAD

- Pick Refferent X 0 : Y 0

- Select Circle all and pick a Table point.

- Create by Songkhran Jongkul 11 September 2021

- https://www.facebook.com/groups/AutolispTH

|;

(defun c:hoch ( / e i ss ch_lst)

(setq old_cmdecho  (getvar "cmdecho"))

(setq old_osnap (getvar "osmode")) 

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

(setvar "cmdecho" 0) 

(setvar "osmode" 0)

(setq tstyle "Hole_chart"

  txth (getdist "\nEnter Text Height : <0.025> ")

  fname "ISOCPEUR"

)

(if (not txtH) (setq txtH 0.025))

;;--------------SET LAYER NAME-----------

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

(command "._layer" "_M" "Hole_chart" "_Color" "3" "" "LType" "Continuous" "" "") 

)

(mystyle tstyle txtH fname)

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

(setvar "osmode" 32) 

(initget 1)

(setq ptu (getpoint "\n Pick reference point X 0 : Y 0 "))

(command "_ucs" "o" (strcat (rtos (car ptu)) "," (rtos (cadr ptu)) "")) ;change UCS to pick point

(setvar "osmode" 0) 

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

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

        (progn

(setq is 1)

(repeat (setq i (sslength ss))

(setq e (ssname ss (setq i (1- i)))

  ly (cdr(assoc 8  (entget e))) ;layer name

  ct (cdr(assoc 10 (entget e))) ;center point

  rd (cdr(assoc 40 (entget e))) ;radial   

)

(setq lst (list is  (trans (list (car ct)(cadr ct) (caddr ct)) 0 1) rd)

  ch_lst (append ch_lst (list lst))

)

(setvar "clayer" "Hole_chart")

(myText tstyle "bl" ct txtH 0 (rtos is 2 0))

(setq is (1+ is))

)

)

    )

(setvar "clayer" old_layer)  

;(print ch_lst)

(table)

(command "_UCS" "world")

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(setvar "clayer" old_layer)   

(princ)

)

(defun table ()

(initget 1)

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

  pt (trans pt 1 0) ;;change coordinate to new ucs

  wt (* txtH 10)

  ht (* txtH 3)

)

(setq ntab (list "Hole No." " X " " Y " "\U+2205"))

(setq pt1 (list (+(car pt)wt) (cadr pt))

  pt2 (list (+(car pt1)wt)(cadr pt))

  pt3 (list (+(car pt2)wt)(cadr pt))

  pt4 (list (+(car pt3)wt)(cadr pt))

)

(setq ptx1 (list (+(car pt)(/ wt 2)) (-(cadr pt)(/ ht 2)))

  ptxt (list (car ptx1)(-(cadr ptx1)ht))

)

(setvar "clayer" "Hole_chart")

(foreach x ntab

(myText tstyle "mc" ptx1 txtH 0 x)

(setq ptx1 (list (+(car ptx1)wt) (cadr ptx1)))

)

(setq pt0_ (list (car pt)  (-(cadr pt) ht))

  pt1_ (list (car pt1) (-(cadr pt1)ht))

  pt2_ (list (car pt2) (-(cadr pt2)ht))

  pt3_ (list (car pt3) (-(cadr pt3)ht))

  pt4_ (list (car pt4) (-(cadr pt4)ht))

)

(command "_line" (trans pt 0 1) (trans pt4 0 1) "" 

"_line" (trans pt0_ 0 1) (trans pt4_ 0 1) "" 

)

(foreach x ch_lst

(myText tstyle "mc" ptxt txtH 0 (rtos (car x) 2 0))

(setq ptxt1 (list (+(car ptxt)wt) (cadr ptxt)))

(myText tstyle "mc" ptxt1 txtH 0 (rtos (car (cadr x))2 2))

(setq ptxt2 (list (+(car ptxt1)wt) (cadr ptxt1)))

(myText tstyle "mc" ptxt2 txtH 0 (rtos (cadr (cadr x))2 2))

(setq ptxt3 (list (+(car ptxt2)wt) (cadr ptxt2)))

(myText tstyle "mc" ptxt3 txtH 0 (rtos (*(caddr x)2)2 2))

(setq ptxt (list (car ptxt) (-(cadr ptxt2)ht)))

(setq pt0_ (list (car pt0_) (-(cadr pt0_) ht))

  pt4_ (list (car pt4_) (-(cadr pt4_) ht))

)

(command "_line" (trans pt0_ 0 1) (trans pt4_ 0 1) "" )

)

(setq htab (* ht (1+(length ch_lst))))

(setq pt0_ (list (car pt)  (-(cadr pt) htab))

  pt1_ (list (car pt1) (-(cadr pt1)htab))

  pt2_ (list (car pt2) (-(cadr pt2)htab))

  pt3_ (list (car pt3) (-(cadr pt3)htab))

  pt4_ (list (car pt4) (-(cadr pt4)htab))

)

(command "_line" (trans pt 0 1) (trans pt0_ 0 1) "" 

"_line" (trans pt1 0 1) (trans pt1_ 0 1) "" 

"_line" (trans pt2 0 1) (trans pt2_ 0 1) ""

"_line" (trans pt3 0 1) (trans pt3_ 0 1) ""

"_line" (trans pt4 0 1) (trans pt4_ 0 1) ""

"_line" (trans pt0_ 0 1) (trans pt4_ 0 1) "" 

)

(setvar "clayer" old_layer)

(princ)

)

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

(defun myText (txtStyle txtJust insertPt textHeight ang txtString)

;(myText tstyle "mc" ptxt txtH ang txt)

(if (= txtJust "M")  (setq horJust 4 verJust 0));Middle

(if (= txtJust "L")  (setq horJust 0 verJust 0));Left

(if (= txtJust "C")  (setq horJust 1 verJust 0));Center

(if (= txtJust "R")  (setq horJust 2 verJust 0));Right

(if (= txtJust "bl") (setq horJust 0 verJust 1));Bottom Left

(if (= txtJust "bc") (setq horJust 1 verJust 1));Bottom Center

(if (= txtJust "br") (setq horJust 2 verJust 1));Bottom Right   

(if (= txtJust "tl") (setq horJust 0 verJust 3));Top Left

(if (= txtJust "tc") (setq horJust 1 verJust 3));Top Center

(if (= txtJust "tr") (setq horJust 2 verJust 3));Top Right

(if (= txtJust "ml") (setq horJust 0 verJust 2));Middle Left    

(if (= txtJust "mc") (setq horJust 1 verJust 2));Middle Center

(if (= txtJust "mr") (setq horJust 2 verJust 2));Middle Right

(entmake

(list

(cons 0 "TEXT")

(cons 100 "AcDbEntity")

(cons 100 "AcDbText")

(cons 7 txtStyle) ;Text style name

(cons 10 insertPt) ;First alignment point

(cons 11 insertPt) ;Second alignment point

(cons 40 textHeight);text Height

(cons 1 txtString) ;Default value (the string itself)

(cons 50 ang) ;Text rotation

(cons 71 0) ;Flags 0=Normal, 2=Backward, 4=Upside down

(cons 72 horJust) ;Horizontal text justification,0=Left,1=Center,2=Right,3=Aligin,4=Middle,5=Fit

(cons 73 verJust) ;Vertical text justification, 0=Baseline,1=Bottom,2=Middle,3=Top

)

)

)

(defun mystyle (tstyle txtH fname)

(entmake

(list

   (cons 0  "STYLE")

   (cons 100  "AcDbSymbolTableRecord")

   (cons 100  "AcDbTextStyleTableRecord")

   (cons 2  tstyle)

   (cons 70  0)

   (cons 40  txtH);<- text height not defined

   (cons 41  1.0)

   (cons 50  0.0)

   (cons 71  0)

   (cons 42  2.0)

   (cons 3  fname)

   (cons 4  "")

 )

)

)

(prompt "\nCreate by Songkhran Jongkul September 2021")

(prompt "\nContact https://www.facebook.com/groups/AutolispTH")

(prompt "\nEnter HOCH to start Hole Chart. ")

(princ)

Geographic to UTM Coordinate Converter

 

U-TURN

 U-TURN

(defun c:u-turn ()

(setq old_cmdecho (getvar "cmdecho"))

(setvar "cmdecho" 0)

(setq st (getpoint "\n Pick Point :")

  p1 (list (car st)(+(cadr st)0.50))

  p2 (list (+(car p1)0.35)(cadr p1))

  p3 (list (car p2)(-(cadr p2)0.25))

  p4 (list (car p3)(-(cadr p3)0.25))

)

(command "_pline" st "W" "0.10" "" p1 "A" p2 "L" p3 "W" "0.30" "0.00" p4 "")

(setvar "cmdecho" old_cmdecho)

(princ)

);end

Find Text and Replace

 

;|    

       Find Text and Replace

       - Enter Text String to find

       - Enter Text String to replace

|;

(defun c:FTAR( / ss)

(setq old_cmdecho  (getvar "cmdecho"))

(setvar "cmdecho" 0)

    (or txt (setq txt "ระดับฐาน*"))

    (setq txttemp (getstring t (strcat "\nFind Text: <" txt "> :")))

    (if (= txttemp "")(setq txttemp txt)

              (setq txt txttemp)

       )

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

       (or ntxt (setq ntxt "ระดับฐาน 100.000 เมตร"))

       (setq ntxttemp (getstring t (strcat "\n Enter Replace Text : <" ntxt ">: " )))

       (if (= ntxttemp "")(setq ntxttemp ntxt)

              (setq ntxt ntxttemp)

       )

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

    (setq ss (ssget "X" (list(cons 0 "*TEXT")(cons 1 txt))))

    (setq cntr 0

                str null

       )

(if ss

       (while (< cntr (sslength ss))

              (setq en(ssname ss cntr))

              (setq enlist(entget en))

              (setq stxt(cdr(assoc 1 enlist)))    

              (setq str ntxt)

              (setq enlist(subst (cons 1 str)(assoc 1 enlist) enlist))

              (entmod enlist)

              (setq cntr(1+ cntr ))

              (princ)

       );while

    (princ "\nNo text entities found.")

)

(setvar "cmdecho" old_cmdecho)

(princ)

);end

(prompt "\nEnter FTAR to start. Find Text Replace. ")

Footing

Add Dot decimal point and comma in Text

;|

      Add Dot decimal point and comma in Text

      Ex. Km.1+000000 to Km.1+000.000

      Ex. 1000 to 1000.000

      Ex. 1000000.00 to 1,000,000.00

      Create and Design by Songkhran Jongkul july 2021

|;

(defun c:addc ( / ss)

(setq old_cmdecho  (getvar "cmdecho"))

(setvar "cmdecho" 0)

(initget "1 2 3")

(setq opt (getkword "\nSelect Options :[ 1 Add Decimal Point .000 / 2 Add Number Decimal .123 / 3 Add Comma to Number ] : <1> "))

(if (= opt "")(setq opt "1"))

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

(if (= opt "2")

      (progn

            (or ndec (setq ndec ".123"))

            (setq dectemp (getstring (strcat "\n Enter Decimal : <" ndec ">: " )))

            (if (= dectemp "")(setq dectemp ndec)

                  (setq ndec dectemp)

            )

      )

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

      (progn

            (if (null dec)(setq dec 3))

            (if (setq tmp (getint (strcat "\nEnter Number of Decimal: <" (rtos dec 2 0) ">: ")))

                  (setq dec tmp)

            )

      )

)

 

(setq ss(ssget '((0 . "TEXT,MTEXT"))))

(setq cntr 0

        str null

)

(while (< cntr (sslength ss))

      (setq en(ssname ss cntr))

      (setq enlist(entget en))

      (setq stxt(cdr(assoc 1 enlist)))   

      (cond

            ((= opt "1")

                  (progn

                        (setq num (strlen stxt)

                                cnt (- num dec)

                        )

                        (setq str (strcat (substr stxt 1 cnt) "." (substr stxt (1+ cnt))))

                  )

            )

            ((= opt "2")(setq str (strcat stxt ndec)))

            ((= opt "3")(setq str (rtoc (atof stxt) dec)))

      )

      (setq enlist(subst (cons 1 str)(assoc 1 enlist) enlist))

      (entmod enlist)

      (setq cntr(1+ cntr ))

(princ)

);while

(setvar "cmdecho" old_cmdecho)

(princ)

)

 

(prompt "\nEnter ADDC to start. ")

 

(defun rtoc ( n p / d i l x );; n = any number p = precision

      (setq d (getvar 'dimzin))

      (setvar 'dimzin 0)

      (setq l (vl-string->list (rtos n 2 p))

              x (cond ((cdr (member 46 (reverse l)))) ((reverse l)))

              i 0

      )

      (setvar 'dimzin d)

      (vl-list->string

            (append

                  (reverse

                        (apply 'append

                              (mapcar

                                    '(lambda ( a b )

                                          (if (and (zerop (rem (setq i (1+ i)) 3)) b)

                                                (list a 44)

                                                (list a)

                                          )

                                    )

                                    x (append (cdr x) '(nil))

                              )

                        )

                  )

                  (member 46 l)

            )

      )

);end

Add decimal point in Text

 

;|

       Add Dot Command Add decimal point in Text

       Ex. Km.1+000000 to Km.1+000.000

       Create and Design by Songkhran Jongkul july 2021

|;

(defun c:adot ()

(setq old_cmdecho  (getvar "cmdecho"))

(setvar "cmdecho" 0)

(if (null dec)

       (setq dec 3)

)

(if (setq tmp (getint (strcat "\nEnter Number of Decimal: <" (rtos dec 2 0) ">: ")))

       (setq dec tmp)

)

(setq ss(ssget '((0 . "TEXT,MTEXT"))))

(setq cntr 0)

(while (< cntr (sslength ss))

       (setq en(ssname ss cntr))

       (setq enlist(entget en))

       (setq s-tex(cdr(assoc 1 enlist)))   

       (setq num (strlen s-tex)

                cnt (- num dec)

                opt (strcat (substr s-tex 1 cnt) "." (substr s-tex (1+ cnt)))

       )

       (setq enlist(subst (cons 1 opt)(assoc 1 enlist) enlist))

       (entmod enlist)

       (setq cntr(+ cntr 1))

(princ)

)

(setvar "cmdecho" old_cmdecho)

(princ)

)

(prompt "\nEnter ADOT to start. ")

Vertical Curve

 

Calculate the Slope

;|

       Pick POLYLINE to Calculate the Slope

       Create and Design by SONGKHRAN JONGKUL June 2021

|;

(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 C:slope ( / ent lst PT1);; x y z

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

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

(setq old_layer (getvar "clayer"))

(setvar "cmdecho" 0)

(setvar "osmode" 0)

(setq txth (getvar 'textsize))

(if (not (tblsearch "LAYER" "SLOPE-TEXT" ));;<=== Layer Name

       (command "._layer" "_M" "SLOPE-TEXT" "_Color" 5 "" "LType" "Continuous" "" "")

)

(command "._style" "SLOPE-TEXT" "RID_TE.shx" 1.00 1.00 0 "n" "n");;font name: RID_TE.shx

(setq ent (entsel "\nPick POLYLINE to calculate the slope:"))

(if

       (and ent

              (wcmatch (cdr (assoc 0 (entget (setq ent (car ent))))) "*POLYLINE") ;all types

       ) ;and

       (setq lst (PolyVert ent)) ;make list

)

(setq lstlen (length lst)

         st 0

         sn 1

)

(repeat lstlen

       (setq p1 (nth st lst);;read point p1

                p2 (nth sn lst);;read point p2

       )

       (if(or(> (cadr p1)(cadr p2))(< (cadr p1)(cadr p2)))

                     (tri p1 p2)

       )

       (setq st (1+ st)

                sn (1+ sn)

       )

);repeat

;(print lst)

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(setvar "clayer" old_layer)

(princ)

)

(princ "\nEnter SLOPE to Start Calculate the Slope. ")

(princ)

(defun PolyVert (POLY / par pt1 lst)

(vl-load-com)

       (setq par

              (if (vlax-curve-isClosed POLY)

                     (vlax-curve-getEndParam POLY) ; else

                     (1+ (vlax-curve-getEndParam POLY))

              )

       )

       (while (setq pt1 (vlax-curve-getPointAtParam POLY (setq par (- par 1))))

              (setq lst (cons pt1 lst))

       )

) ; return lst

(defun tri (p1 p2 /) ;;calculate slope and draw triangle

(setq ang (angle p1 p2)

         trih (* txth 1.50)

)

(setq mp (polar p1 ang (/ (distance p1 p2) 2.0)))

(setq pta1 (polar mp (dtor 270.0) trih))

(if(< (cadr p1) (cadr p2))

       (setq Xdis (- (car p2)(car p1))

                Ydis (- (cadr p2)(cadr p1))             

       )

       (setq Xdis (- (car p2)(car p1))

                Ydis (- (cadr p1)(cadr p2))

       )

)

(setq angsl (rtod(atan(/ Ydis Xdis)))

         perc (* (/ Ydis Xdis) 100)

         ratio (/ 1 (tan (dtor angsl)))

)

(setq lb (/ trih (tan (dtor angsl))))

(if (and(> (rtod ang) 0)(< (rtod ang) 90))

       (progn

              (setq pta2 (polar pta1 (dtor 180.0) lb))

              (setq txtlr (list (+(car pta1)txth)(+(cadr pta1)(/ trih 2.0))))

              (setq txtblr (list (-(car pta1)(/ lb 2.0))(-(cadr pta1)(/ txth 2.0))))

       )

       (progn

              (setq pta2 (polar pta1 (dtor 0) lb))

              (setq txtlr (list (-(car pta1)txth)(+(cadr pta1)(/ trih 2.0))))

              (setq txtblr (list (+(car pta1)(/ lb 2.0))(-(cadr pta1)(/ txth 2.0))))

       )

)

(command "_pline" mp pta1 pta2 "c")

(myText "SLOPE-TEXT" "mc" txtlr txth 0 1 "1");angle 0 colour 1

(myText "SLOPE-TEXT" "tc" txtblr txth 0 1 (rtos ratio 2 2));angle 0 colour 1

(myText "SLOPE-TEXT" "bc" mp txth ang 1

       (strcat "Ang " (rtos angsl 2 2) "%%d"

              " Slope " (rtos perc 2 2) "%"

              " 1:"(rtos ratio 2 2)

       )

)

(princ)

);end tri

 

(defun myText (txtStyle txtJust insertPt textHeight ang col txtString)

       (if (= txtJust "L") (setq horJust 0

                                                  verJust 0));Left

       (if (= txtJust "C") (setq horJust 1

                                                  verJust 0));Center

       (if (= txtJust "R") (setq horJust 2

                                                  verJust 0));Right

                                                 

       (if (= txtJust "bl") (setq horJust 0

                                                   verJust 1));Bottom Left

       (if (= txtJust "bc") (setq horJust 1

                                                   verJust 1));Bottom Center

       (if (= txtJust "br") (setq horJust 2

                                                   verJust 1));Bottom Right

                                                  

       (if (= txtJust "ml") (setq horJust 0

                                                   verJust 2));Middle Left                                              

       (if (= txtJust "mc") (setq horJust 1

                                                   verJust 2));Middle Center

       (if (= txtJust "mr") (setq horJust 2

                                                   verJust 2));Middle Right 

                                                  

       (if (= txtJust "tl") (setq horJust 0

                                                   verJust 3));Top Left

       (if (= txtJust "tc") (setq horJust 1

                                                   verJust 3));Top Center

       (if (= txtJust "tr") (setq horJust 2

                                                   verJust 3));Top Right   

 

;(myText "AREA-TEXT" "mc" pt txth 0 col tarea)

;These values are just being used for testing

 ;(setq txtStyle "Standard")

 ;(setq insertPt (list 2.0 3.0))

 ;(setq txtString "test")

 

 (entmake

  (list

   (cons 0 "TEXT")

   (cons 100 "AcDbEntity")

   (cons 100 "AcDbText")

   (cons 7  txtStyle) ;Text style name

   (cons 10 insertPt) ;First alignment point

   (cons 11 insertPt) ;Second alignment point

   (cons 40 textHeight)

   (cons 1  txtString) ;Default value (the string itself)

   (cons 50 ang) ;Text rotation

   (cons 62 col) ;Text Colour

   (cons 71 0) ;Flags 0=Normal, 2=Backward, 4=Upside down

   (cons 72 horJust) ;Horizontal text justification,0=Left,1=Center,2=Right,4=Center,5=Fit

   (cons 73 verJust) ;Vertical text justification, 0=Baseline,1=Bottom,2=Middle,3=Top

  )

 )

)