;|
Insert Block from csv Excel File.
- Create and Design by Songkhran Jongkul
23-04-2021
- Add Options Coordinate Point N E Elv or
X Y Z
|;
(defun
c:imcsv ();(/ Deconstruct_String file st)
;;-----radial
to dreegee
(defun rtod (x)
(/ (* x 180) pi)
)
;;-----dreegee
to radial
(defun dtor (x)
(* x (/ pi 180))
)
;;-----------------------------------------
(setq
old_cmdecho (getvar
"cmdecho"))
(setq
old_osnap (getvar "osmode"))
(setq
old_cecolor (getvar "CECOLOR"))
(setq
old_layer (getvar "clayer")) ; layer
;;-----------------------------------------
(setvar
"cmdecho" 0)
(setvar
"osmode" 0)
(setq
fname "RID_TE.shx" ;"FreesiaUPC"
txtsty "Des_Blocks"
txth 2.50
lyblk "Blocks_Layer"
lydesc "Descriptions"
;drawline "1"
)
;;-----------------------------------------
(initget
"1 2")
(setq
coord (getkword "\nCoordinate point Options [1 N E Elv. / 2 X Y Z] :
<1> "))
(if
(= coord "")(setq coord "1"))
;;-----------------------------------------
(initget
"1 2 3 4")
(setq
destxt (getkword "\nDescriptions Text Options[1 None. / 2 No. / 3
Descriptions / 4 No. Descriptions] : <1> "))
(if
(= destxt "")(setq destxt "1"))
;;-----------------------------------------
(initget
"1 2")
(setq
drawline (getkword "\nOptions Draw Polyline [1 Yes. / 2 No.] : <1> "))
(if
(= drawline "")(setq drawline "1"))
;;-----------------------------------------
(if
(= drawline "1")
(if (not (tblsearch "LAYER"
"Polyline_Layer"));;<=== Layer Name
(command "._layer"
"_M" "Polyline_Layer" "_Color" "7"
"" "LType" "Continuous" ""
"");;<=== Layer Name
)
)
(if (not (tblsearch "LAYER"
lyblk));;<=== Layer Name FI
(command "._layer"
"_M" lyblk "_Color" "1" ""
"LType" "Continuous" "" "");;<===
Layer Name
)
(if (not (tblsearch "LAYER"
lydesc));;<=== Layer Name
(command "._layer"
"_M" lydesc "_Color" "2" ""
"LType" "Continuous" "" "");;<===
Layer Name
)
(if (not (tblsearch "Style"
txtsty))
;(command "-style"
"newstylename" "fontname" "textheight"
"widthfactor" "0" "" "" "")
(command "_style" txtsty
fname "" "" "0" "" "") ;
Fonts Thai FreesiaUPC
)
(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))
)
(Setq
p1 nil
ss1 nil
)
(if
(setq file (getfiled "Select 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) ",")) ;String all;0-No.
1-blkname 2-N 3-E 4-elv
5-scX 6-scY 7-Angle 8-Descriptions
(setq pt0 (list (read (nth
0 p))(read (nth 1 p))(read (nth 2 p))(read (nth 3 p))(read (nth 4 p))(read (nth
5 p))(read (nth 6 p))(read (nth 7 p))(read (nth 8 p))))
(setq lst (cons p lst))
(if (= (nth 8 p)
"")
(setq desc "
")
(setq desc (nth 8 p))
)
(if (= coord "1") ;N E elv or X Y Z
(setq pt (list (nth 3
pt0) (nth 2 pt0) (nth 4 pt0))) ;N E Elv.
(setq pt (list (nth 2
pt0) (nth 3 pt0) (nth 4 pt0))) ;X Y Z
)
(setq no (nth 0 p)
blkname (nth 1 p)
scX (nth 5 pt0)
scY (nth 6 pt0)
ang (nth 7 pt0)
)
(setvar "clayer"
lyblk)
(entmake
(list '(0 .
"INSERT")
(cons 2
blkname) ;block name
(cons 10 pt) ;insert point
(cons 41 scx) ;scale x
(cons 42 scy) ;scale y
;(cons 43 scz) ;scale z
(cons 50 (dtor
ang)) ;angle radial
)
)
(setvar "clayer"
lydesc)
(if (/= desc nil)
(myText txtsty
"ml" pt txth 0
(cond
((=
destxt "1")(strcat "
" ))
((=
destxt "2")(strcat "
" no "." ))
((=
destxt "3")(strcat "
" desc))
((=
destxt "4")(strcat "
" no ". " desc))
)
)
)
;;-----------draw
pline------------------
(if (= drawline
"1")
(progn
(setvar
"clayer" "Polyline_Layer")
(if (/= p1 nil)
(progn
(command
"_.pline" "_none" p1 "_none" pt "")
(setq
ss2 (entlast))
)
)
(if (/= ss1 nil)
(progn
(command
"_.pedit" "_multiple" ss1 ss2 ""
"_join" "0.0" "")
(setq
ss2 (entlast))
)
(setq ss1 ss2)
)
(setq p1 pt)
)
)
;;---------------------------------------
);while
(close file)
);progn
(princ)
);if
(command
"_zoom" "_E")
;;-----------------------------------------------------------
(setvar
"cmdecho" old_cmdecho)
(setvar
"osmode" old_osnap)
(setvar
"cecolor" old_cecolor)
(setvar
"clayer" old_layer)
(princ)
);end
defun
(prompt
"\nEnter IMCSV to start. ")
(prompt
"\nCreate and Design by Songkhran Jongkul 23-04-2021")
;;---------------------------------------------------
(defun
myText (txtStyle txtJust insertPt textHeight ang 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 "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
;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 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
)
)
)
ไม่มีความคิดเห็น:
แสดงความคิดเห็น