AutoLISP TH

วันพฤหัสบดีที่ 23 มิถุนายน พ.ศ. 2565

Screw Flight CADThai,AutoCAD

Screw Flight CADThai

Create and Design by SONGKHRAN JONGKUL June 2022

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

(defun rtod (x)

(/ (* x 180) pi)

)

(defun dtor (x)

(* x (/ pi 180))

)

(defun my_error (msg)

(if

(or

(= msg "Function cancelled")

(= msg "quit / exit abort")

)

(princ)

(princ (strcat "\n Error: " msg))

)

(if msg (Alert (strcat "\n Application error: " msg)))

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(setvar "orthomode" old_ortho)

(setq *error* old_error)

(princ)

);;end my_error

(defun c:scwf (/)

(vl-load-com)

;---------------Load the dcl file ------------------------

(create_scwf)

(setq dcl_id (load_dialog fname))

(setq old_cmdecho (getvar "cmdecho"))

(setq old_osnap (getvar "osmode"))

(setq old_ortho (getvar "orthomode"))

(setq old_error *error*)

(setq *error* my_error )

;***************** set default edit box ********************************************

(IF (NOT od) (SETQ od "125.0") (if (= (type od) 'STR) T (SETQ od "125.0")));edt1

(IF (NOT id) (SETQ id "27.0") (if (= (type id) 'STR) T (SETQ id "27.0")));edt2

(IF (NOT pit) (SETQ pit "80.0 ") (if (= (type pit) 'STR) T (SETQ pit "80.0 ")));edt3

(if (new_dialog "Screw" dcl_id)

(progn

(SET_TILE "edt1" od)

(SET_TILE "edt2" id)

(SET_TILE "edt3" pit)

(ACTION_TILE "edt1" "(setq od $value)")

(ACTION_TILE "edt2" "(setq id $value)")

(ACTION_TILE "edt3" "(setq pit $value)")

;--------------Logo Image------------

(setq w (dimx_tile "im") ;get image tile width

h (dimy_tile "im") ;get image tile height

);setq

(start_image "im") ;start the image

(fill_image 0 0 w h -15) ;fill it with blue

(mapcar 'vector_image; Color 5

(list 36 42 42 48 54 48 48 42 36 21 21 27 27 33 32 32 32 27 27 21 5 5 8 15 11 11 5 5 5 8 18 21 18 11 11 11 15 15 21 18 8 5)

(list 8 15 15 27 3 3 3 3 3 11 27 18 18 27 15 15 3 11 3 3 6 14 17 17 24 20 20 20 24 27 27 24 14 14 6 6 6 11 3 3 3 6)

(list 36 42 48 54 54 54 48 48 42 21 27 27 33 42 36 36 36 32 27 27 5 8 15 15 15 11 11 5 8 18 21 21 21 18 11 15 15 21 21 21 18 8)

(list 22 27 27 27 27 3 18 18 3 17 27 27 27 27 22 8 3 3 11 3 14 17 17 24 24 24 20 24 27 27 24 27 17 14 14 6 11 11 6 6 3 3)

(list 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5 5)

);mapcar

(end_image)

;------------default image-----------

(mode_tile "edt1" 0);0 on ;1 off

(mode_tile "edt2" 0)

(mode_tile "edt3" 0)

(setq x (dimx_tile "vectors")

y (dimy_tile "vectors")

)

(start_image "vectors");;cone

(fill_image 0 0 x y -2) ;fill it with blue

(mapcar 'vector_image; Color 1

(list 77 81 82 81 77 77 144 144 151 144 144 146 150 151 144 167 167 160 160 160 160 160 162 166 167 160)

(list 18 18 15 14 14 14 94 95 94 88 88 87 87 88 91 98 93 93 93 98 87 87 86 86 87 90)

(list 81 82 82 82 81 77 144 151 151 144 146 150 151 151 151 167 167 167 160 167 160 162 166 167 167 167)

(list 18 16 16 15 14 21 96 95 96 92 87 87 88 92 91 98 98 93 98 98 91 86 86 87 91 90)

(list 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)

);mapcar

(mapcar 'vector_image; Color 2

(list 170 171 170 171 154 155 154 155 171 131 92 155 140 140 125 125 44 44 44 127 44)

(list 130 133 53 50 100 102 84 82 50 50 133 82 82 102 25 23 24 24 24 23 23)

(list 171 172 171 172 155 156 155 156 171 172 172 155 156 156 127 127 46 46 127 127 44)

(list 133 130 50 53 102 100 82 84 133 50 133 102 82 102 24 24 25 23 24 47 46)

(list 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2)

);mapcar

(mapcar 'vector_image; Color 252

(list 136 136 134 134 136 138 136 33 33 35 35 33 33 33 28)

(list 92 82 86 86 92 97 102 97 97 102 92 87 87 87 92)

(list 138 138 136 136 138 138 138 35 35 37 37 35 33 35 140)

(list 86 86 82 92 97 97 97 92 102 97 97 92 87 82 92)

(list 252 252 252 252 252 252 252 252 252 252 252 252 252 252 252)

);mapcar

(mapcar 'vector_image; Color 3

(list 109 109 110 112 115 119 123 126 126 103 128 63 35 81 79 75 72 69 66 64 60 57 54 50 47 44 59 55 52 49 46 35 67 70 74 80 85 103 100 97 94 91 89 85 82 80 78 75 71 67 62 57 53 49 44 127 44)

(list 80 80 76 71 62 54 51 50 50 102 82 82 102 132 130 124 118 110 102 92 80 72 65 59 54 50 89 86 83 82 82 82 93 96 99 101 102 102 112 120 126 131 133 133 132 129 125 118 108 93 78 65 58 52 50 50 50)

(list 109 110 112 115 119 123 126 126 127 136 136 128 66 85 81 79 75 72 69 66 64 60 57 54 50 47 63 59 55 52 49 46 70 74 80 85 103 103 103 100 97 94 91 89 85 82 80 78 75 71 67 62 57 53 49 128 44)

(list 82 76 71 62 54 51 50 82 50 102 82 82 102 133 132 130 124 118 110 102 92 80 72 65 59 54 91 89 86 83 82 82 96 99 101 102 102 105 105 112 120 126 131 133 133 132 129 125 118 108 93 78 65 58 52 82 82)

(list 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3)

);mapcar

(end_image)

;**************************************************************

;;;--- If an action event occurs, do this function

(action_tile "accept" "(setq ddiag 2)(done_dialog)")

(action_tile "cancel" "(setq ddiag 1)(done_dialog)")

;;;--- Display the dialog box

(start_dialog)

;;;--- Unload the dialog box

(unload_dialog dcl_id)

(if (= ddiag 1)

(princ "\n Screw Flight Cancelled. ")

)

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

(if (= ddiag 2)

(progn

(setq old_cmdecho (getvar "cmdecho"))

(setq old_osnap (getvar "osmode"))

(setq old_ortho (getvar "orthomode"))

(setvar "osmode" 0)

(setvar "orthomode" 0)

(setvar "cmdecho" 0)

;-----------input--------------------

(setq dx (atof od) ;125.0

dn (atof id) ;27.0

pitc (atof pit);80.0

)

;-----------calculator--------------------

(setq l1 (sqrt(+(expt (* pi dn) 2)(expt pitc 2)))

l2 (sqrt(+(expt (* pi dx) 2)(expt pitc 2)))

)

(setq d1 (/(- dx dn)(-(/ l2 l1)1))

d2 (+(- dx dn) d1)

)

(setq ang (- 360 (/ l2(/ (* d2 pi)360)))

s (* (* 2 (/ d2 2)) (sin (dtor(/ ang 2))))

)

;-----------set position--------------------

(setq pt (getpoint "\n Pick a Center Point. :")

p1 (polar pt (dtor(/ ang 2))(/ d2 2))

p2 (polar pt (dtor(- 360(/ ang 2)))(/ d2 2))

p3 (polar pt (dtor(/ ang 2))(/ d1 2))

p4 (polar pt (dtor(- 360(/ ang 2)))(/ d1 2))

)

;-----------drawing--------------------

(command "_arc" "c" pt p1 p2)

(setq ss1 (ssget "L"))

(command "_arc" "c" pt p3 p4)

(setq ss2 (ssget "L"))

(command "_pline" p1 p3 "")

(setq ss3 (ssget "L"))

(command "_pline" p2 p4 "")

(setq ss4 (ssget "L"))

(setq pe (getvar 'PEDITACCEPT))

(setvar 'PEDITACCEPT 1)

(command "_.pedit" "_M" ss1 ss2 ss3 ss4 "" "_J" "" "")

(setvar 'PEDITACCEPT pe)

)

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(setvar "orthomode" old_ortho)

(princ)

)

(prompt "\nCreate and Design by SONGKHRAN JONGKUL June 2022")

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

(prompt "\nEnter SCWF to Start Screw Flight.")

(defun create_scwf ()

(setq fname (vl-filename-mktemp "Screw.dcl"))

(setq fn (open fname "w"))

;;-----------------Screw Flight Dialog--------------------

(write-line "Screw : dialog { "fn)

(write-line " label = \" Screw Flight \"; "fn)

(write-line " width = 30; "fn)

(write-line " fixed_width = 1; "fn)

(write-line " : image { "fn)

(write-line " alignment = centered; "fn)

(write-line " key = \"vectors\"; "fn)

(write-line " width = 33.26; "fn)

(write-line " height = 11.51; "fn)

(write-line " fixed_width = true; "fn)

(write-line " fixed_height = true; "fn)

(write-line " aspect_ratio = 1; "fn)

(write-line " color = -2; "fn)

(write-line " } "fn)

(write-line " : boxed_column { "fn)

(write-line " label = \" Screw Dimensions \"; "fn)

(write-line " width = 30; "fn)

(write-line " fixed_width = 1; "fn)

(write-line " : column { "fn)

(write-line " : edit_box { "fn)

(write-line " key = \"edt1\" ; "fn)

(write-line " label = \"Outside Diameter :\"; "fn)

(write-line " edit_width = 6; "fn)

(write-line " value = \"\"; "fn)

(write-line " initial_focus = true; "fn)

(write-line " } "fn)

(write-line " : edit_box { "fn)

(write-line " key = \"edt2\"; "fn)

(write-line " label = \"Inner Diameter :\"; "fn)

(write-line " edit_width = 6; "fn)

(write-line " value = \"\"; "fn)

(write-line " } "fn)

(write-line " : edit_box { "fn)

(write-line " key = \"edt3\"; "fn)

(write-line " label = \"Pitch (mm.) :\"; "fn)

(write-line " edit_width = 6; "fn)

(write-line " value = \"\"; "fn)

(write-line " } "fn)

(write-line " : row { "fn)

(write-line " : column { "fn)

(write-line " : ok_button { "fn)

(write-line " alignment = right; "fn)

(write-line " width = 11; "fn)

(write-line " } "fn)

(write-line " : column { "fn)

(write-line " : cancel_button { "fn)

(write-line " alignment = left; "fn)

(write-line " width = 11; "fn)

(write-line " } "fn)

(write-line " : row { "fn)

(write-line " : image { "fn)

(write-line " key = \"im\" ; "fn)

(write-line " width = 10.02; "fn)

(write-line " height = 2.28; "fn)

(write-line " alignment = right; "fn)

(write-line " } "fn)

(write-line " : paragraph { "fn)

(write-line " : text_part { "fn)

(write-line " label = \"Created June 2022\"; "fn)

(write-line " alignment = left; "fn)

(write-line " } "fn)

(write-line " : text_part { "fn)

(write-line " label = \"by SongKhraN Jongkul\"; "fn)

(write-line " alignment = left; "fn)

(write-line " } "fn)

(write-line "} "fn)

(close fn)

);defun

วันอังคารที่ 3 พฤษภาคม พ.ศ. 2565

dimensions distance perpendicular on parallel line

dimensions distance perpendicular on parallel line.

- Enter Length of Distance on main line.

- Select object. (main all line and arc)

- Select object. (Parallel Line Done arc)

(defun LenghtOfObject (obj / len)

(if (vl-catch-all-error-p (setq len (vl-catch-all-apply 'vlax-curve-getDistAtParam

(list obj (vl-catch-all-apply 'vlax-curve-getEndParam (list obj)))))) nil len

)

(defun c:dimpll (/ lst)

(vl-load-com)

(setq old_cmdecho (getvar "cmdecho"))

(setq old_osnap (getvar "osmode"))

(setvar "cmdecho" 0)

(setvar "snapmode" 0)

;;----------Line STA Length--------

(or dis (setq dis 1.0))

(setq lttemp

(getDist (strcat "\nLength of Distance : <"

(rtos dis 2 2)

">: "

) ;_ strcat

) ;_ getdist

) ;_ setq

(and lttemp (setq dis lttemp))

(setq path (entsel "Select Main Line: "))

(setq x_object (vlax-Ename->Vla-Object (car path)))

(setq lpath (LenghtOfObject x_object);start point

;pt2 (vlax-curve-getendpoint x_object);end point

sta_dis dis

lst (list)

lst_ppt (list)

)

(repeat (fix(/ lpath dis))

(setq p1 (vlax-curve-getpointatdist x_object (abs sta_dis)));;Measure Multiple Distances

(setq sta_dis (+ sta_dis dis)

lst (append lst (list p1))

)

;(print lst)

(setq pll (car (entsel "\nSelect Parallel Line : ")))

(if(= (cdr (assoc 0 (setq e (entget pll)))) "ARC")

(progn

(alert "This ARC Invalid object. Please select Parallel Line object.")

(exit)

)

(setq ent1 (car path)

ent2 pll

ent3 (car path)

)

(foreach x lst

(lb3 ent1 ent2 ent3 x)

)

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(princ)

)

(prompt "\nCreate and Design by Songkhran Jongkul April 2022")

(princ "\nEnter DIMPLL to Start")

(defun LB3 (ent1 ent2 ent3 pt1 / obj1 obj2 pt2); = Lines Between 3 objects

(command "_.pline"

"_none" pt1

"_none"

(polar

pt1

(+ (angle '(0 0 0) (vlax-curve-getFirstDeriv ent1 (vlax-curve-getParamAtPoint ent1 pt1))) (/ pi 2))

); polar

); command

(setq obj1 (vlax-ename->vla-object ent2)

obj2 (vlax-ename->vla-object (entlast))

pt2 (vlax-invoke obj1 'IntersectWith obj2 acExtendBoth)

); setq

(entdel (entlast))

(command "_.pline" "_none" pt1 "_none" pt2 "_none" (vlax-curve-getClosestPointTo ent3 pt2) "")

(command "_.DIMALIGNED"

"_none" (trans pt1 0 1)

"_none" (trans pt2 0 1)

"_none" (trans pt1 0 1)

)

(princ)

)

วันจันทร์ที่ 11 เมษายน พ.ศ. 2565

Dim. parallel line.

dimensions distance perpendicular on parallel line.

- Enter Length of Distance on main line.

- Select object. (main line)

- Select object. (Parallel Line)

(defun LB3 (ent1 ent2 ent3 pt1 / obj1 obj2 pt2); = Lines Between 3 objects

(command

"_.line"

"_none"

pt1

"_none"

(polar

pt1

(+ (angle '(0 0 0) (vlax-curve-getFirstDeriv ent1 (vlax-curve-getParamAtPoint ent1 pt1))) (/ pi 2))

); polar

); command

(setq obj1 (vlax-ename->vla-object ent2)

obj2 (vlax-ename->vla-object (entlast))

pt2 (vlax-invoke obj1 'IntersectWith obj2 acExtendBoth)

); setq

(entdel (entlast))

(command "_.DIMALIGNED"

"_none" (trans pt1 0 1)

"_none" (trans pt2 0 1)

"_none" (trans pt1 0 1)

)

(princ)

)

(defun c:dimpll (/ lst)

(vl-load-com)

(setq old_cmdecho (getvar "cmdecho"))

(setq old_osnap (getvar "osmode"))

(setvar "cmdecho" 0)

(setvar "snapmode" 0)

;;----------Line STA Length--------

(or dis (setq dis 1.0))

(setq lttemp

(getDist (strcat "\nLength of Distance : <"

(rtos dis 2 2)

">: "

) ;_ strcat

) ;_ getdist

) ;_ setq

(and lttemp (setq dis lttemp))

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

(setq path (entsel "Select Main Line: "))

(setq x_object (vlax-Ename->Vla-Object (car path)))

(setq pt1 (vlax-curve-getstartpoint x_object);start point

pt2 (vlax-curve-getendpoint x_object);end point

sta_dis dis

lst (list)

lst_ppt (list)

)

(repeat (fix(/ (distance pt1 pt2) dis))

(setq p1 (vlax-curve-getpointatdist x_object (abs sta_dis)));;Measure Multiple Distances

(setq sta_dis (+ sta_dis dis)

lst (append lst (list p1))

)

;(print lst)

(setq pline (car (entsel "\nSelect Parallel Line: ")))

(setq ent1 (car path)

ent2 pline

ent3 (car path)

)

(foreach x lst

(lb3 ent1 ent2 ent3 x)

)

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(princ)

)

(prompt "\n Create and Design by Songkhran Jongkul April 2022")

(prompt "\n Enter DIMPLL to Start")

วันจันทร์ที่ 21 มีนาคม พ.ศ. 2565

Point to Circle and Circle to Point

;;Point to Circle and Circle to Point

(defun c:p2c ( / e i s )

;;-------------Input Radial-------------------------

(or rd (setq rd 0.2))

(setq rdtemp

(getDist (strcat "\nEnter Radial : <"

(rtos rd 2 3)

">: "

) ;_ strcat

) ;_ getint

) ;_ setq

(and rdtemp (setq rd rdtemp))

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

(if (setq s (ssget '((0 . "POINT"))))

(repeat (setq i (sslength s))

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

(if (entmake

(list '(0 . "CIRCLE")

(assoc 10 (entget e))

(cons 40 rd)

)

(entdel e)

)

(princ)

)

(defun c:c2p ( / e i s )

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

(repeat (setq i (sslength s))

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

(if (entmake

(list '(0 . "POINT")

(assoc 10 (entget e))

)

(entdel e)

)

(princ)

)

วันอาทิตย์ที่ 13 มีนาคม พ.ศ. 2565

Polyline Dimensions

(defun c:pdim(/ plSet pLlst vLst vLst0 vLst1 oldOsn cAng cDis cPt index)

(princ "\n<<< Select LwPolyline for dimensioning >>> ")

(if(setq plSet(ssget '((0 . "LWPOLYLINE"))))

(progn

(setq index -1

oldOsn(getvar "OSMODE")

)

(setq pLlst(vl-remove-if 'listp (mapcar 'cadr(ssnamex plSet))))

(setvar "OSMODE" 0)

(setvar "CMDECHO" 0)

(foreach pl pLlst

(setq vLst(mapcar 'cdr (vl-remove-if-not '(lambda(x)(= 10(car x)))(entget pl)))

reg (ssname plSet (setq index (1+ index)))

); end setq

;(print vLst) ;original points list

(if (and(= (car (nth 0 vLst))(car (nth (1- (length vLst)) vLst)))

(= (cadr (nth 0 vLst))(cadr (nth (1- (length vLst)) vLst)))

)

(setq vLst1 vLst)

;(progn

(if (= (cdr (assoc 70 (entget reg))) 1)

(progn

(setq vLst1 vLst)

(setq vLst0 (list (car(nth 0 vLst))(cadr(nth 0 vLst))))

(setq vLst1 (reverse (cons vLst0 (reverse vLst1))))

)

(setq vLst1 vLst)

)

;)

)

;(print vLst1) ;after check points list

(while(< 1(length vLst1))

(setq cAng(angle(car vLst1)(cadr vLst1))

cDis(/(distance(car vLst1)(cadr vLst1))2)

cPt(polar (polar(car vLst1)cAng cDis) (+ cAng(/ pi 2)) (* 2 (getvar "DIMTXT")))

); end setq

(command "_.dimaligned"(car vLst1)(cadr vLst1) cPt)

(setq vLst1(cdr vLst1))

); end while

); end foreach

(setvar "OSMODE" oldOsn)

(setvar "CMDECHO" 1)

); end progn

); end if

(princ)

); end of c:pdim

วันพฤหัสบดีที่ 23 มิถุนายน พ.ศ. 2565

Screw Flight CADThai,AutoCAD

วันอังคารที่ 3 พฤษภาคม พ.ศ. 2565

dimensions distance perpendicular on parallel line

วันจันทร์ที่ 11 เมษายน พ.ศ. 2565

Dim. parallel line.

วันจันทร์ที่ 21 มีนาคม พ.ศ. 2565

Point to Circle and Circle to Point

วันอาทิตย์ที่ 13 มีนาคม พ.ศ. 2565

Polyline Dimensions

ป้ายกำกับ

สมัครสมาชิก