AutoCAD Tips: Visual LISP เปลี่ยนขนาดโดนัทแบบระบายทึบ

วันนี้เข้าเว็บ Support ของ Autodesk ห้อง Visual LISP ที่เคยเข้าไปตอบอยู่
มีท่านหนึ่งตั้งโจทย์ จะเปลี่ยนขนาดเส้นผ่านศูนย์กลางของโดนัทแบบระบายทึบ
ที่วาดเอาไว้แล้วได้อย่างไร โดยยังคงตำแหน่งไว้อย่างเดิม

เลยลองนำมาเขียนโค้ดและนำไปโพสต์ตอบเอาไว้

หลักๆ ก็คือเลือกรูปวาด LWPOLINE
เช็ค Group code 90 จำนวน vertices เท่ากับ 2
เช็ค Group code 70 ค่า 1 หมายถึง Closed Polyline
แล้วคำนวณหาจุดศูนย์กลางจาก Group code 10
ที่เป็นจุดยอดทั้งสอง นำมาค่าเฉลี่ย

ใช้คำสั่ง SCALE เพื่อปรับขนาดด้วยค่าขนาดใหม่หารด้วยขนาดเส้นผ่านศูนย์กลางเดิม

เส้นผ่านศูนย์กลางเดิมมีค่าเท่ากับ
Group code 40, 41 นำมาคูณสองเท่า

;; Donut center
(defun donutcenter (a / pts p q)
(foreach l a
(if (= (car l) 10)
(setq pts (append pts (list (cdr l))))
)
)
(setq p (car pts)
q (cadr pts)
)
(mapcar '/ (mapcar '+ p q) (list 2.0 2.0 2.0))
)
;; Donut diameter
(defun donutdiameter (a)
(* 2.0 (cdr (assoc 40 a)))
)
;; Change donut diameter
(defun changedonutsize (a newdia)
(command ".scale"
(cdr (assoc -1 a))
""
(donutcenter a)
(/ newdia (donutdiameter a))
)
)
;;; Main
(defun c:redonut (/ s e a j oldosmode *error*)
(if (not #newdia)
(setq #newdia 2.0)
)
(setq oldosmode (getvar "osmode"))
(setvar "cmdecho" 0)
(command ".undo" "begin")
(defun *error* (msg)
(if (not (member msg (list "Function cancelled")))
(princ (strcat "REDONUT Error: " msg))
)
(command ".undo" "end")
(setvar "osmode" oldosmode)
(setvar "cmdecho" 1)
(princ)
)
(foreach msg (list "\nEnter new diamter of donut:<" #newdia "> ")
(princ msg)
)
(if (setq tmp (getdist))
(setq #newdia tmp)
)
(if (setq
s (ssget (list (cons 0 "LWPOLYLINE") (cons 90 2) (cons 70 1)))
)
(progn
(setvar "osmode" 0)
(setq j -1)
(repeat (sslength s)
(setq e (ssname s (setq j (1+ j)))
a (entget e)
)
(changedonutsize a #newdia)
)
(command ".undo" "end")
(setvar "osmode" oldosmode)
(setvar "cmdecho" 1)
)
(princ "\nNo object found!!!")
)
(princ)
)