วันอังคารที่ 27 เมษายน พ.ศ. 2564
วันศุกร์ที่ 23 เมษายน พ.ศ. 2564
Insert Block from csv Excel File.
;|
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
)
)
)
วันจันทร์ที่ 5 เมษายน พ.ศ. 2564
Elevation Line
;|
Elevation Line
- by : AutoLispTH@hotmail.com
|;
(defun
c:ELL ()
(setq
old_cmdecho (getvar
"cmdecho"))
(setq
old_osnap (getvar "osmode"))
(setq
old_ortho (getvar "orthomode"))
(setq
old_tstyle (getvar "textstyle"))
(setq
old_dimzin (getvar "dimzin"))
(setq
txts (getvar "textstyle"))
(setq
txth (getvar "textsize"))
(setvar
"cmdecho" 0)
(setvar
"osmode" 0)
(setvar
"dimzin" 4)
(or st_elv (setq st_elv 10.000));start
elevation
(setq st_elvtemp
(getdist (strcat "\n Enter Start
Elevation : <"
(rtos st_elv 2 3)
">: "
) ;_ strcat
) ;_ getdist
) ;_ setq
(and st_elvtemp (setq st_elv st_elvtemp))
;;----------------------------------------------
(setq sc_y 1) ;Vertical Scale
(setvar "osmode" 33); 1=end
point 32=intersection
(setq pt1 (getpoint "\nStart Point :
"))
(setvar "osmode" 0)
(command "_TEXT" "BL"
pt1 txth "" (strcat "+" (rtos st_elv 2 3)))
(setvar "osmode" 33)
(while (setq pt2 (getpoint
"\nElevation Point : "))
(if (>= (cadr pt2)(cadr pt1))
(progn
(setq elv (*(+ st_elv
(- (cadr pt2) (cadr pt1)))sc_y))
(setq txt (strcat
"+" (rtos elv 2 3)))
)
(progn
(setq elv (*(- st_elv
(- (cadr pt1) (cadr pt2)))sc_y))
(setq txt
(if (<= elv
0.000)
(strcat
(rtos elv 2 3))
(strcat
"+" (rtos elv 2 3))
)
)
)
)
(setvar "osmode" 0)
(command "_TEXT"
"BL" pt2 txth "" txt)
(setvar "osmode" 33);
1=end point 32=intersection
);while
(setvar
"cmdecho" old_cmdecho)
(setvar
"osmode" old_osnap)
(setvar
"orthomode" old_ortho)
(setvar
"textstyle" old_tstyle)
(setvar
"dimzin" old_dimzin)
(princ)
)
(prompt
"\nEnter ELL to Start Elevations Line.")
วันพฤหัสบดีที่ 18 มีนาคม พ.ศ. 2564
Circle to Dimond C2DM
;|
- Circle to Dimond
- Create by Songkhran Jongkul 19 March
2021
-
https://www.facebook.com/groups/AutolispTH
|;
(defun
c:c2dm ( / e i ss)
(setq
old_cmdecho (getvar
"cmdecho"))
(setq
old_osnap (getvar "osmode"))
(setq
old_layer (getvar "clayer")) ;
layer
(setvar
"cmdecho" 0)
(setvar
"osmode" 0)
(if (setq ss (ssget "_:L" '((0 .
"CIRCLE"))))
(progn
(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
)
(command
"_erase" e "")
(setq dm1 (list (-(car
ct) rd)(cadr ct))
dm2 (list (+(car ct) rd)(cadr ct))
dm3 (list (car ct)(+(cadr ct)(* rd 1.50)))
dm4 (list (car ct)(-(cadr ct)(* rd 1.50)))
)
(setvar
"clayer" ly)
(command
"_pline" dm1 dm3 dm2 dm4 "c")
)
)
)
(setvar
"cmdecho" old_cmdecho)
(setvar
"osmode" old_osnap)
(setvar
"clayer" old_layer)
(princ)
)
(prompt
"\nEnter C2DM to start. ")
วันพฤหัสบดีที่ 11 มีนาคม พ.ศ. 2564
Point or Circle Closest To Text (CC2TNEZDa)
(defun
print_out (lst / a)
(foreach a lst
(princ "\n")
(princ a)
)
)
;|
25-11-2020
Point or Circle Closest To Text
change text to mtext for 3D coordinate
add table Z ( elevations)
27-11-2020
add table distance a1 to a2 in plan view
10-03-2021
add opt2 => No. E N Z D
|;
(defun
c:cc2tnezda ( / points texts i j pt pb ind dst d result)
(setq
old_cmdecho (getvar
"cmdecho"))
(setvar
"cmdecho" 0)
(setq txtH (getvar "TEXTSIZE"))
(setq txtS (getvar "textstyle"))
(initget
"1 2 3")
(setq opt (getkword "\nSelect Options
: \n [1 Pick points. / 2 Select object. / 3 Find All. ] <1> "))
(if (= opt "")(setq opt
"1"))
;;-------------------------------------
(if
(or(= opt "1")(= opt "2")(= opt "3"))
(progn
;;---------------------------
(initget "1 2")
(setq opt2 (getkword "\nSelect
Options : \n [1 Symbol N E Z D / 2 No E N Z D ] <1> "))
(if (= opt2 "")(setq opt2
"1"))
(if (= opt2 "1")
(progn
;;-----------Enter
String Symbol -----
(if (null sta)(setq sta
"A"))
(setq statemp (getstring
(strcat "\n Enter String Symbol <"
sta ">: ")))
(if (eq statemp "")
(setq statemp sta)
(setq sta statemp)
)
;;----------Number
Start Count--------
(or nma (setq nma 1))
(setq nmatemp
(getDist (strcat
"\nEnter Number : <"
(rtos nma 2 0)
">: "
) ;_ strcat
) ;_ getdist
) ;_ setq
(and nmatemp (setq nma
nmatemp))
);;progn
(progn ;;;options 2
;;----------Number Start Count--------
(or nma (setq nma 1))
(setq nmatemp
(getDist (strcat
"\nEnter Number : <"
(rtos nma 2 0)
">: "
) ;_ strcat
) ;_ getdist
) ;_ setq
(and nmatemp (setq nma
nmatemp))
);progn
);;if
);progn
);if
;;------------------------------------
(setq
pb nil)
(if
(= opt "1")
(progn
(while(setq pt (getpoint "\nPick
Points :"))
(if (= pb nil)(setq pb pt))
(if (= opt2 "1")
(setq txt (strcat "
" (strcase sta) (rtos nma 2 0)))
(setq txt (strcat "
" (rtos nma 2 0)))
)
(metxt pt 7 txth 0 txt)
(setq result
(append result
(list
(list
txt ;;
text
(car pt) ;; x value of point
(cadr pt) ;; y value of point
(caddr pt) ;; z value of point
(distance
(list (car pt)(cadr pt)) (list (car pb)(cadr pb)))
)
)
)
)
(setq nma (1+ nma)
pb pt
)
)
(setq lst1 result)
)
);if
= Pick points
;;-----------------------------
(if
(= opt "2")
(progn
(princ "\n Select circle
mark.")
(if (setq ss (ssget '((0 .
"POINT,CIRCLE"))))
(progn
(setq ctr 0
numss (sslength ss)
)
(repeat (setq in
(sslength ss))
(setq pt (cdr (assoc
10 (entget (ssname ss (setq in (1- in)))))))
(if (= pb
nil)(setq pb pt))
(if (= opt2
"1")
(setq txt
(strcat " " (strcase sta) (rtos nma 2 0)))
(setq txt
(strcat " " (rtos nma 2 0)))
)
(metxt pt 7 txth 0
txt)
(setq result
(append
result
(list
(list
txt ;;
text
(car
pt) ;; x value of point
(cadr
pt) ;; y value of point
(caddr
pt) ;; z value of point
(distance
(list (car pt)(cadr pt)) (list (car pb)(cadr pb)))
)
)
)
)
(setq nma (1+ nma)
pb pt
)
(setq ctr (1+
ctr))
)
(setq lst1 result)
)
)
)
)
;;-----------------------------
(if
(= opt "3")
(progn
(initget "1 2")
(setq opt1 (getkword "\nSelect
Options : \n [ 1 Point / 2 Circle ] <1> "))
(if (= opt1 "")(setq opt1
"1"))
(if (= opt1 "1")
(setq points (ssget "_X"
'((0 . "POINT"))))
(setq points (ssget "_X"
'((0 . "CIRCLE"))))
)
(setq texts (ssget "_X" (list (cons 0
"MTEXT,TEXT"))))
(setq result (list))
(setq pc nil)
(repeat (setq im (sslength points))
(setq ent (ssname points (setq im
(1- im))));;;make reverse points
(setq j 0)
(setq dst nil) ;; this will hold the closest distance.
(setq ind nil)
(repeat (sslength texts)
(setq d (distance
(setq pt
(cdr (assoc 10 (entget ent)))) ;;
insert point of the point
(cdr (assoc
10 (entget (ssname texts j)))) ;; insert point of the text
)
)
(if (or (= dst nil) (< d
dst))
(progn
(setq dst d)
(setq ind j)
)
)
(setq j (+ j 1))
)
(if (= pc nil)(setq pc pt))
(setq result
(append result
(list
(list
(cdr (assoc
1 (entget (ssname texts ind)))) ;; text
(nth 0
pt) ;;
x value of point
(nth 1
pt) ;;
y value of point
(nth 2 pt) ;;
z value of point
(distance
(list (car pt)(cadr pt)) (list (car pc)(cadr pc)))
)
)
)
)
(ssdel (ssname texts ind) texts)
(setq pc pt)
)
(setq lst1 result);(reverse result)
)
)
(print_out result)
(print_table lst1)
(setvar
"cmdecho" old_cmdecho)
(princ)
);;end
(prompt
"\nEnter CC2TNEZDa to start Circle Closest to text.")
;;------------------------------------------------------
(defun
metxt (pt pos txth ang txt);;Mtext Maker
(entmake
(list
(cons 0
"MTEXT")
(cons 100
"AcDbEntity")
(cons 100
"AcDbMText")
(cons 7
"txtS");;fontstyle
(cons 8
"CC2T_NEZ");;Layer nmae
(cons 71 pos) ; 1=Top
Left /2=Top Center /3= Top Right
; 4=Middle Left/5=Middle Center/6=Middle
Right
; 7=Bottom Left/8=Bottom Center/9=Bottom
Right
(cons 72 5)
(cons 73 1)
(cons 10 pt);;Text point
(cons 11 (list 1.0 0.0
0.0))
(cons 50 ang);;Angle
Radial only
;(cons 41 19.35)
(cons 40 TXTH);;Text
Height
(cons 44 1.0)
(cons 1 TXT);;Text
String
);list
);entmake
)
;;------------------------------------------------------
(defun
print_table (lst / )
(setq
old_osnap (getvar "osmode")) ;
osnap
(setq
old_layer (getvar "clayer")) ;
layer
(setvar
"osmode" 0)
(setq pt0 (getpoint "\nPick a table
point :")
txth (getvar "TEXTSIZE")
dec 3
num 0
nump (length lst)
)
(setq pt1
(list (+(car pt0)(* txth 10))(cadr pt0))
ptx1 (list (+(car pt0)(* txth 5)) (-(cadr pt0)(* txth 1.0)))
pt2 (list (+(car pt1)(* txth
10))(cadr pt1))
ptx2 (list (+(car pt1)(* txth 5)) (-(cadr pt1)(* txth 1.0)))
pt3 (list (+(car pt2)(* txth
10))(cadr pt2))
ptx3 (list (+(car pt2)(* txth 5)) (-(cadr pt2)(* txth 1.0)))
pt4 (list (+(car pt3)(* txth
10))(cadr pt3)) ;;Z
elevations
ptx4 (list (+(car pt3)(* txth 5)) (-(cadr pt3)(* txth 1.0)))
pt5 (list (+(car pt4)(* txth
10))(cadr pt4)) ;;distance
ptx5 (list (+(car pt4)(* txth 5)) (-(cadr pt4)(* txth 1.0)))
)
(setvar "clayer"
"CC2T_NEZ")
(command "_line" pt0 pt5
"")
(if (= opt2 "1")
(progn
(metxt ptx1 5 txth 0
"SYMBOL")
(metxt ptx2 5 txth 0
"NORTH")
(metxt ptx3 5 txth 0
"EAST")
(metxt ptx4 5 txth 0
"ELEVATIONS")
(metxt ptx5 5 txth 0
"DISTANCE")
)
(progn
(metxt ptx1 5 txth 0
"NO.")
(metxt ptx2 5 txth 0
"EAST")
(metxt ptx3 5 txth 0
"NORTH")
(metxt ptx4 5 txth 0
"ELEVATIONS")
(metxt ptx5 5 txth 0
"DISTANCE")
)
)
(setq pt0b
(list (car pt0)(-(cadr pt0)(* txth 2.0)))
pt1b (list (car pt1)(-(cadr
pt1)(* txth 2.0)))
pt2b (list (car pt2)(-(cadr
pt2)(* txth 2.0)))
pt3b (list (car pt3)(-(cadr
pt3)(* txth 2.0)))
pt4b (list (car pt4)(-(cadr
pt4)(* txth 2.0)));;elevations
pt5b (list (car pt5)(-(cadr
pt5)(* txth 2.0)));;distance
)
(command "_line" pt0b pt5b
"")
(repeat nump
(setq ptx1 (list (car ptx1) (-(cadr
ptx1)(* txth 2.0)))
ptx2 (list (car ptx2) (-(cadr ptx2)(* txth
2.0)))
ptx3 (list (car ptx3) (-(cadr ptx3)(* txth
2.0)))
ptx4 (list (car ptx4) (-(cadr ptx4)(* txth
2.0)))
ptx5 (list (car ptx5) (-(cadr ptx5)(* txth
2.0)))
)
(if (= opt2 "1")
(progn
(metxt ptx1 5 txth 0 (nth 0
(nth num lst)))
(metxt ptx2 5 txth 0 (rtos
(nth 2 (nth num lst))2 dec));N
(metxt ptx3 5 txth 0 (rtos
(nth 1 (nth num lst))2 dec));E
(metxt ptx4 5 txth 0 (rtos
(nth 3 (nth num lst))2 dec));Z
(metxt ptx5 5 txth 0 (rtos
(nth 4 (nth num lst))2 dec));D
)
(progn
(metxt ptx1 5 txth 0 (nth 0
(nth num lst)))
(metxt ptx2 5 txth 0 (rtos
(nth 1 (nth num lst))2 dec));E
(metxt ptx3 5 txth 0 (rtos
(nth 2 (nth num lst))2 dec));N
(metxt ptx4 5 txth 0 (rtos
(nth 3 (nth num lst))2 dec));Z
(metxt ptx5 5 txth 0 (rtos
(nth 4 (nth num lst))2 dec));D
)
)
(setq pt0b (list (car pt0b)(-(cadr pt0b)(* txth 2.0)))
pt1b
(list (car pt1b)(-(cadr pt1b)(* txth 2.0)))
pt2b
(list (car pt2b)(-(cadr pt2b)(* txth 2.0)))
pt3b
(list (car pt3b)(-(cadr pt3b)(* txth 2.0)))
pt4b
(list (car pt4b)(-(cadr pt4b)(* txth 2.0)))
pt5b
(list (car pt5b)(-(cadr pt5b)(* txth 2.0)))
)
(command "_line" pt0b pt5b
"")
(setq num (1+ num))
);repeat
(command "_line" pt0 pt0b
"")
(command "_line" pt1 pt1b
"")
(command "_line" pt2 pt2b
"")
(command "_line" pt3 pt3b
"")
(command "_line" pt4 pt4b
"")
(command "_line" pt5 pt5b
"")
(princ)
(setvar
"osmode" old_osnap) ; old_osnap
(setvar
"clayer" old_layer) ; old_layer
(princ)
)
สมัครสมาชิก:
บทความ (Atom)