Lisp Request

Lisp Request

ผมต้องการเลือกจุดสองจุดที่วงกลมเล็ก รูปซ้ายมือ

แล้วให้มันสร้างเส้นเซ็นเตอร์ให้เป็นเส้นสีแดงฝั่งขวามือ

รบกวนพี่ๆช่วยเขียนให้หน่อยครับ

(defun c:RECL ()

(setq old_cmdecho  (getvar "cmdecho"))

(setq old_osnap (getvar "osmode"))

(setvar "cmdecho" 0)

(setvar "osmode" 37);; 1+4+32 1=endpoint 4=center 32= intersection

      (setq p1 (getpoint "\nPick Start Point : "))

      (setq p2 (getcorner p1 "\nPick Corner Point : "))

      (setvar "osmode" 0)

      (setq leng (distance p1 p2))

      (setq pc (polar p1 (angle p1 p2) (/ leng 2.0))

              pl (list (-(car pc)(/ leng 2.0))(cadr pc))

              pr (list (+(car pc)(/ leng 2.0))(cadr pc))

              pt (list (car pc)(+(cadr pc)(/ leng 2.0)))

              pb (list (car pc)(-(cadr pc)(/ leng 2.0)))

      )

      (if (null (tblsearch "LType" "center"));if null center line

        (command "_linetype" "load" "center" "acad.lin" "")

    )

      (command "_line" pl pr "")

      (setq ss0 (ssget "L"))

      (command "_line" pt pb "")

      (setq ss1 (ssget "L"))

      (command "_chprop" ss0 ss1 "" "_ltype" "center" "")

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(princ)    

)

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

;; แบบที่ 2 จะเป็นแบบเลือกครอบหัวเสาทีละหลายๆ เสาพร้อมกันทีเดียวเลย

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

(defun c:SREC ()

(setq old_cmdecho  (getvar "cmdecho"))

(setq old_osnap (getvar "osmode"))

(setvar "cmdecho" 0)

(setvar "osmode" 0)

(if (null (tblsearch "LType" "center"));if null center line

    (command "_linetype" "load" "center" "acad.lin" "")

)

(setq ss (ssget (list '(0 . "*POLYLINE"))))

(setq i -1)

(repeat (sslength ss)   

      (setq en (ssname ss (setq i (1+ i))))

      (vla-getboundingbox (vlax-ename->vla-object en) 'll 'ur)

      (setq ll (vlax-safearray->list ll);;low left

          ur (vlax-safearray->list ur);;up right

          pc (polar ll (angle ll ur) (/ (distance ll ur) 2.0))

              pl (list (-(car pc)(/ (distance ll ur) 2.0))(cadr pc))

              pr (list (+(car pc)(/ (distance ll ur) 2.0))(cadr pc))

              pt (list (car pc)(+(cadr pc)(/ (distance ll ur) 2.0)))

              pb (list (car pc)(-(cadr pc)(/ (distance ll ur) 2.0)))

      )

      (command "_line" pl pr "")

      (setq ss0 (ssget "L"))

      (command "_line" pt pb "")

      (setq ss1 (ssget "L"))

      (command "_chprop" ss0 ss1 "" "_ltype" "center" "")

(princ)    

)

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(princ)    

)
;;----------------------------------------------------------------

รบกวนพี่ๆอีกครั้งครับ

ผมต้องการ Lisp ให้คลิ๊กที่ จุดที่1 และจุดที่2 แล้วก็ให้โปรแกรมสร้างเส้น line ให้โดยเว้น Gap ให้อัตโนมัติ

ตัวอย่างรูปด้านซ้าย เมื่อเสร็จแล้วจะเป็นรูปแบบด้านขวา

ขั้นตอนการใช้งาน

1.คือใส่ค่า Gap เช่น 15 ก็จะเว้นจากชิ้นงาน 15 ทั้งสองฝั่ง

2.เลือกที่ขอบชิ้นงานทั้ง 2 ฝั่งแล้วสร้างเส้น Line ที่มี Gap 15 ทั้งสองฝั่งให้

(defun c:Lgap ()

(setq old_cmdecho (getvar "cmdecho"))

(setq old_osnap (getvar "osmode"))

(setvar "cmdecho" 0)

(setvar "osmode" 33)

(setq p1 (getpoint "\nPick Start Point : "))

(setq p2 (getpoint p1 "\nPick End Point : "))

(setvar "osmode" 0)

(setq gab 15.0);;Gab Distance

(setq p1a (polar p1 (angle p1 p2) gab)

p2a (polar p2 (angle p2 p1) gab)

)

(command "_line" p1a p2a "")

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(princ)

)

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

ตรงค่าที่เว้นอ่าครับผมอยากให้สามารถ ป้อนค่าเข้าไปได้นะครับตรงนี้มันจะเว้นเท่าขนาด สเกลที่ใช้งาน ไม่ได้เว้น 15 ทุกครั้งนะครับ

(defun c:Lgap ()

(setq old_cmdecho (getvar "cmdecho"))

(setq old_osnap (getvar "osmode"))

(setvar "cmdecho" 0)

(setvar "osmode" 33)

(or gab (setq gab 15.0))

(setq gabtemp

(getdist (strcat "\n Enter Gab Distance : <"

(rtos gab 2 2)

">: "

) ;_ strcat

) ;_ getdist

) ;_ setq

(and gabtemp (setq gab gabtemp))

(while (setq p1 (getpoint "\nPick Start Point : "))

(setq p2 (getpoint p1 "\nPick End Point : "))

(setvar "osmode" 0)

;(setq gab 15.0);;Gab Distance

(setq p1a (polar p1 (angle p1 p2) gab)

p2a (polar p2 (angle p2 p1) gab)

)

(command "_line" p1a p2a "")

(setvar "osmode" 33)

);while

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(princ)

)

SSGET POINT Coordinate X,Y,Z to Excel .CVS File.

SSGET POINT Coordinate X,Y,Z to Excel .CVS File.

การเลือกตำแหน่ง (point) โดยการเลือกครอบตำแหน่งที่ต้องการทั้งหมด แล้วทำการส่งค่า (Coordinate X,Y,Z) ไปยัง Excel โดยการบันทึกเป็นไฟล์ .CVS แล้วค่อยเลือกบันทึกเป็น .xlsx เป็นไฟล์ Excel เพื่อนำค่าไปใช้ต่อไป

(defun c:P2CVS2 (/)

(setq old_cmdecho  (getvar "cmdecho"))

(setvar "cmdecho" 0)

(setq txth (getvar "TEXTSIZE"))

(if (setq fn (getfiled "Save to CSV file." "" "csv" 1))

    (progn

              (setq f (open fn "w")) ;Open the file for writing

              (write-line (strcat "Num.,X,Y,Z") f) ;Write header line to file      

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

                     (progn

                           (setq is 1)

                            (repeat (setq i (sslength ss))

                                  (setq ent  (entget (ssname ss (setq i (1- i))))

                                           pt   (cdr (assoc 10 ent))

                                  )

                                  (command "_point" pt)

                                  (command "_text" "mc" pt txth "0" (rtos is 2 0))

                                  (write-line

                                         (strcat (rtos is 2 0)

                                                ","

                                                (rtos(car pt)2 3)

                                                ","

                                                (rtos(cadr pt)2 3)

                                                ","

                                                (rtos(caddr pt)2 3)

                                         );strcat

                                         f

                                  );write-line

                                  (setq is (1+ is))    

                           );repeat

                     );progn

              );if ssget

              (close f) ;Close the file

              (princ)

       );progn

       (princ "Stopped. Exit.");if don't save cvs file

);if

(setvar "cmdecho" old_cmdecho)

(princ)

);End

Find Text Replace with Blocks

;|     

       Find Text Replace with Blocks

       - Enter Text String

       - Enter Block Name

|;

(defun c:t2b( / ss)

(setq old_cmdecho  (getvar "cmdecho"))

(setvar "cmdecho" 0)

(vl-load-com)

       (or txt (setq txt "CL"))

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

       (if (= txt "")(setq txt "CL"))

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

       (or blk (setq blk "CL100"))

       (setq blk (getstring t (strcat "\nBlock Name: <" blk "> :")))

       (if (= blk "")(setq blk "CL100"))

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

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

       (if ss

              (progn

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

                     (mapcar '(lambda (x) (vl-cmdf "-insert" blk (cdr (assoc 10 (entget x))) 1 1 (* (/ 180 pi)

                                                                                                (cdr (assoc 50 (entget x)))))

                                  (entdel x)) ss

                     )

              )

              (princ "\nNo text entities found.")

       )

(setvar "cmdecho" old_cmdecho)

(princ)

);end

(prompt "\nEnter T2B to start. Find Text Replace with Blocks. ")

Find Text and Replace

;|     

       Find Text and Replace

       - Enter Old Text String

       - Enter New Text String

|;

(defun C:TRC (/ told tnew tss tdata); = Text Replace for Complete text/mtext strings

(setq old_cmdecho  (getvar "cmdecho"))

(setvar "cmdecho" 0)

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

       (or told (setq told "Test"))

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

       (if (= told "")(setq told "Test"))

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

       (or tnew (setq tnew "Replace"))

       (setq tnew (getstring t (strcat "\nText Replace: <" tnew "> :")))

       (if (= tnew "")(setq tnew "Replace"))

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

       (setq tss (ssget "X" (list (cons 1 told))))

       (repeat (sslength tss)

              (setq tdata (entget (ssname tss 0))

                       tdata (subst (cons 1 tnew) (assoc 1 tdata) tdata)

              ); end setq

              (entmod tdata)

              (ssdel (ssname tss 0) tss)

       ); end repeat

(setvar "cmdecho" old_cmdecho)

(princ)      

); end defun

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

Run String / Number or String&Number

;|

      Run String / Number or String&Number

      Select Options 1 String 2 Number 3 String&Number

|;

(defun c:RST ()

(setq old_cmdecho  (getvar "cmdecho"))

(setvar "cmdecho" 0)

      (setq txtH (getvar "TEXTSIZE"))

      (setq txtS (getvar "textstyle"))

(initget "1 2 3")

      (setq opt (getkword "\mSelect Options : \n [1  String / 2  Number / 3  String&Number ] <1> "))

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

      (if (or(= opt "1")(= opt "3"))(setq sta (getstring "\nEnter String : ")))

      (if (or(= opt "2")(= opt "3"))(setq nma (getreal "\nEnter Number : ")))

(while(setq pt (getpoint "\nPick Point :"))

      (if (= opt "1")

            (progn

                  (command "_.text" "_s" txtS "_j" "ml" pt txtH 0 sta)      

                  (setq sta (ascii sta)

                          sta (1+ sta)

                          sta (chr sta)

                  )

            )

      )

      (if (= opt "2")

            (progn

                  (command "_.text" "_s" txtS "_j" "ml" pt txtH 0 (rtos nma 2 3))

                  (setq nma (1+ nma))

            )

      )

      (if (= opt "3")

            (progn

                  (setq txt (strcat sta (rtos nma 2 3)))

                  (command "_.text" "_s" txtS "_j" "ml" pt txtH 0 txt)

                  (setq nma (1+ nma))

            )

      )    

      (princ)

);while     

(setvar "cmdecho" old_cmdecho)

(princ)

);end

(prompt "\nEnter RST to start. ")

Point to Excel .cvs file.

Pick POINT Coordinate X,Y,Z to Excel .CVS File.

การเลือกตำแหน่ง (point) โดยการกดเลือกเอาตามตำแหน่งที่ต้องการ แล้วทำการส่งค่า (Coordinate X,Y,Z) ไปยัง Excel โดยการบันทึกเป็นไฟล์ .CVS แล้วค่อยเลือกบันทึกเป็น .xlsx เป็นไฟล์ Excel เพื่อนำค่าไปใช้ต่อไป

(defun c:P2CVS1 (/)

(setq old_cmdecho  (getvar "cmdecho"))

(setq old_osnap (getvar "osmode")) 

(setvar "cmdecho" 0) 

(setvar "osmode" 37)  ;; 1+4+32 1=endpoint 4=center 32=node      

(setq txth (getvar "TEXTSIZE"))

(if (setq fn (getfiled "Save to CSV file." "" "csv" 1))

    (progn

              (setq f (open fn "w")) ;Open the file for writing

              (write-line (strcat "Num.,X,Y,Z") f) ;Write header line to file      

              (setq i 1)

              (while (setq pt (getpoint "\nPick Point : <Enter to Exit.>"))

                     (command "_point" pt)

                     (command "_text" "mc" pt txth "0" (rtos i 2 0))

                     (write-line 

                           (strcat (rtos i 2 0)

                           ","

                           (rtos(car pt)2 3)

                           ","

                           (rtos(cadr pt)2 3)

                           ","

                           (rtos(caddr pt)2 3)

                           );strcat

                     f

                     );write-line

              (setq i (1+ i))

              )

              (close f) ;Close the file

              (princ)

       );progn

       (princ "Stopped. Exit.");if don't save cvs file

);if

(setvar "cmdecho" old_cmdecho)

(setvar "osmode" old_osnap)

(princ)

);End

AUTOCAD Make SLIDE LIBRARY

AUTOCAD Make SLIDE LIBRARY By AutoLispTH

ขั้นตอนในการทา SLIDE LIBRARY เราต้องมี BLOCKS ที่เราต้องการรวบไว้ใน FLODER ที่เราสร้างไว้อย่างเช่น BOLT แล้วก็แยกออกเป็น HEXAGON กับ SOCKET

ใน FOLDER ย่อยเช่น HEXAGON ก็มี BLOCKS FILES (.DWG) กับ SLIDE FILES (.SLD) แล้ว TEXT FILE (.TXT) แล้วก็ตัวโปรแกรม สร้าง SLIDE FILE ชื่อ SLIDELIB.EXE ตามรูป

สำหรับ TEXT FILE (.TXT) เราก็สร้างด้วย NOTEPAD ใส่ชื่อ SLIDE ลงไปให้ครบเท่าที่มี

ต่อไปเราก็มาสร้างตัว SLIDE LIBRARY กัน โดยเข้าไปที่ DOS MODE พอดีผมใช้ WIN10 ก็กดปุ่ม เครื่องหมาย ค้นหา (แว่นขยาย) พิมพ์ cmd แล้วก็เลือกCOMMAND PROMPT เข้าไปใน DOS MODE

หน้าตาของเจ้า DOS MODE ให้เรากด CD\ เพื่อออกจาก SUB FOLDER ของวินโดร์มาอยู่ที่ C:\> แล้วก็เข้าไปที่ FOLDER BOLT ของเราด้วย CD BOLT แล้วก็เข้าไปที่ HEXAGON ด้วย CD HEXAGON จากนั้นก็สร้างเจ้า SLIDE LIBRARY ด้วยคำสั่งนี้

SLIDELIB HEXAGON < HEXAGON.TXT

(ชื่อคาสั่ง) (ชื่อสไลด์ไฟล์) (TEXT FILE ที่เราใส่ชื่อสไลด์ลงไป)

เมื่อเราสร้างเสร็จแล้วก็จะได้ไฟล์ HEXAGON.SLB เป็นตัว SLIDES FILE ถ้าเป็น เวอร์ชั่น เก่าเมื่อก่อนต้องเข้าไปเขียนเมนูเพิ่มเอาในไฟล์ ACAD.MNU แต่ว่าตัวใหม่นี้เราใช้ MENULOAD แทน ดังนั้นเราต้องสร้าง MENU FILE ขึ้นมาใหม่เลย ตัวออย่างที่ผมทำ เช่น MYMENU.MNU

โดยใช้ NOTEPAD เขียนตามรูปตัวอย่างแล้วเซฟเป็น ไฟล์ MyMenu.MNU บันทึกไว้ใน BOLT FOLDER เลยนะครับ ต่อไปเราก็ไป LOADMENU กัน การสร้างเมนู Creating Menu

เข้า CAD เลย พิมพ์ MENULOAD แล้ว ENTER

1.    Browse เข้าไปใน BOLT FOLDER เลือกไฟล์เมนูที่เราสร้างไว้ MyMenu.mnu

2.    กด Load เมนูของเราจะปรากฏขึ้นมาต่อท้ายเมนูบาร์ด้านบน My Menu

3.    กด Close ปิดหน้าต่าง

4.    สำหรับเมื่อเราต้องการยกเลิกการใช้งานก็เลือก MyMenu แล้วกด Unload เมนูบาร์ก็จะหายไป

จากนั้นตัว CAD เพิ่มเมนูใหม่ของเราเข้าไปท้ายสุดของเมนูบาร์

ถ้ารูป SLIDE ไม่โชว์แสดงว่าเรายังไม่ได้เซ็ท SUPPORT FILE SEARCH PAHT เข้าไปเซ็ทด้วยนะครับ

TRICK การสร้างรูปสไลด์ให้พอดีกับช่อง

-THE END-