Khi muốn chỉnh sửa textstyle của 1 đối tượng text nào đó trên bản vẽ, ta phải biết tên textstyle áp dụng vào text đó. Theo cách thông thường thì phải làm theo trình tự sau: Chọn text -> kiểm tra textstyle -> gõ lệnh st -> tìm kiếm style muốn đổi trong danh sách. mất tương đối nhiều thời gian.
Lisp này cho phép bạn pick vào đối tượng TEXT để gọi hộp thoại sửa textstyle tương ứng của...

Khi muốn chỉnh sửa textstyle của 1 đối tượng text nào đó trên bản vẽ, ta phải biết tên textstyle áp dụng vào text đó. Theo cách thông thường thì phải làm theo trình tự sau: Chọn text -> kiểm tra textstyle -> gõ lệnh st -> tìm kiếm style muốn đổi trong danh sách. mất tương đối nhiều thời gian.
Lisp này cho phép bạn pick vào đối tượng TEXT để gọi hộp thoại sửa textstyle tương ứng của nó luôn.

(defun c:st (/ style c-style)
(and
(setq style (car (entsel)))
(setq style (cdr (assoc 7 (entget style))))
(setq c-style (getvar "textstyle"))
(setvar "textstyle" style)
(or
(initdia)
(command "style")
(if (= (getvar "textstyle") style)
(setvar "textstyle" c-style))))
(princ))

Tương tự như vậy với lệnh DST (dimstyle). code tương tự nên mình không viết lại nữa

Chán bạn! Hỏi 3 câu thì trả lời 1 câu, câu mình muốn nhận được trả lời thì không trả lời, những trao đổi dành cho người khác không liên can gì đến mình thì lại chen vào ý kiến (!?) Rồi lại quanh quẩn cái bài bông hoa, không biết đưa vô đây định làm gì nữa!? hiểu được chết liền!

Mình tiếp tục nội dung topic:
- Lệnh Br (Break): Sau khi gõ lệnh con trỏ ở trạng thái ô...

Chán bạn! Hỏi 3 câu thì trả lời 1 câu, câu mình muốn nhận được trả lời thì không trả lời, những trao đổi dành cho người khác không liên can gì đến mình thì lại chen vào ý kiến (!?) Rồi lại quanh quẩn cái bài bông hoa, không biết đưa vô đây định làm gì nữa!? hiểu được chết liền!

Mình tiếp tục nội dung topic:
- Lệnh Br (Break): Sau khi gõ lệnh con trỏ ở trạng thái ô vuông, mục đích để bạn có thể chọn được chính xác đối tượng muốn break, tuy nhiên nó khiến bạn không thể chọn chính xác điểm break đầu (muốn chọn chính xác bạn phải gõ thêm phím F - First point). Ngoài ra nếu tại điểm pick đầu tiên có 2 hay nhiều đối tượng giao nhau sẽ khiến bạn không thể chọn chính xác đối tượng mà bạn muốn). Mình đưa ra phương pháp chọn hợp lý hơn và nhanh hơn.

(defun C:BR (/ ss p pause en)
(and
(setq p (getpoint))
(not
(while
(not
(setq ss (ssget "C" p p '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))))
)
)
(if (> (sslength ss) 1)
(not
(while
(not
(ssmemb (setq en (car (entsel " Chon doi tuong break"))) ss))
)
)
(setq en (ssname ss 0)))
(not (redraw en 3))
(vl-cmdf "break" en "f" p (getpoint)))
(princ))


- Lệnh PE (Pedit): lệnh này quy định hơi khác thường: Không cho phép chọn trước đối tượng, không mặc định chon nhiều đối tượng luôn khi gõ lệnh. Mình sửa để loại bỏ các quy định bất tiện này.

(defun C:PE (/ SS)
(if (setq SS (ssget))
(vl-cmdf "PEDIT" "M" SS "")
(vl-cmdf "PEDIT" "M" Pause))
(princ))

Chán bạn! Hỏi 3 câu thì trả lời 1 câu, câu mình muốn nhận được trả lời thì không trả lời, những trao đổi dành cho người khác không liên can gì đến mình thì lại chen vào ý kiến (!?) Rồi lại quanh quẩn cái bài bông hoa, không biết đưa vô đây định làm gì nữa!? hiểu được chết liền!

Mình tiếp tục nội dung topic:
- Lệnh Br (Break): Sau khi gõ lệnh con trỏ ở trạng thái ô...

Chán bạn! Hỏi 3 câu thì trả lời 1 câu, câu mình muốn nhận được trả lời thì không trả lời, những trao đổi dành cho người khác không liên can gì đến mình thì lại chen vào ý kiến (!?) Rồi lại quanh quẩn cái bài bông hoa, không biết đưa vô đây định làm gì nữa!? hiểu được chết liền!

Mình tiếp tục nội dung topic:
- Lệnh Br (Break): Sau khi gõ lệnh con trỏ ở trạng thái ô vuông, mục đích để bạn có thể chọn được chính xác đối tượng muốn break, tuy nhiên nó khiến bạn không thể chọn chính xác điểm break đầu (muốn chọn chính xác bạn phải gõ thêm phím F - First point). Ngoài ra nếu tại điểm pick đầu tiên có 2 hay nhiều đối tượng giao nhau sẽ khiến bạn không thể chọn chính xác đối tượng mà bạn muốn). Mình đưa ra phương pháp chọn hợp lý hơn và nhanh hơn.

(defun C:BR (/ ss p pause en)
(and
(setq p (getpoint))
(not
(while
(not
(setq ss (ssget "C" p p '((0 . "ARC,CIRCLE,ELLIPSE,*LINE")))))
)
)
(if (> (sslength ss) 1)
(not
(while
(not
(ssmemb (setq en (car (entsel " Chon doi tuong break"))) ss))
)
)
(setq en (ssname ss 0)))
(not (redraw en 3))
(vl-cmdf "break" en "f" p (getpoint)))
(princ))


- Lệnh PE (Pedit): lệnh này quy định hơi khác thường: Không cho phép chọn trước đối tượng, không mặc định chon nhiều đối tượng luôn khi gõ lệnh. Mình sửa để loại bỏ các quy định bất tiện này.

(defun C:PE (/ SS)
(if (setq SS (ssget))
(vl-cmdf "PEDIT" "M" SS "")
(vl-cmdf "PEDIT" "M" Pause))
(princ))

Chào bác duy782006, Lisp dpo.lsp Thiep viết gần đáp ứng yêu cầu của bác. Thiep đề nghị một số ý như sau:
- Chọn 1 điểm cơ sở (thuộc đối tượng do mình pick) cũng chính là điểm pick khi chọn đối tượng, và cũng dùng điểm này để xác định vị trí đầu curve (từ endpoint hay từ startpoint) từ đó để đo khoảng cách để cần xác định điểm point (giống như trong lệnh ME). Đây là lisp...

Chào bác duy782006, Lisp dpo.lsp Thiep viết gần đáp ứng yêu cầu của bác. Thiep đề nghị một số ý như sau:
- Chọn 1 điểm cơ sở (thuộc đối tượng do mình pick) cũng chính là điểm pick khi chọn đối tượng, và cũng dùng điểm này để xác định vị trí đầu curve (từ endpoint hay từ startpoint) từ đó để đo khoảng cách để cần xác định điểm point (giống như trong lệnh ME). Đây là lisp Thiep đã chỉnh sửa:

(defun c:tinha ( / x KQ)
(setq x (getreal "nhap so thuc x "))
(if (and ( > x 2 )(< x (* 2 pi)))
(progn
(princ (strcat "gia tri x da nhap: " (rtos x ) " thoa man 2 < " (rtos x ) " < 2pi"))
(princ)
(setq KQ (sin (/ (- ( * 5 x) 2) (sqrt (- x 2)))))
)
(progn
(princ (strcat "gia tri x da nhap: " (rtos x ) "/nphai tinh theo co (2 + 5x)" ))

>>

(defun c:tinha ( / x KQ)
(setq x (getreal "nhap so thuc x "))
(if (and ( > x 2 )(< x (* 2 pi)))
(progn
(princ (strcat "gia tri x da nhap: " (rtos x ) " thoa man 2 < " (rtos x ) " < 2pi"))
(princ)
(setq KQ (sin (/ (- ( * 5 x) 2) (sqrt (- x 2)))))
)
(progn
(princ (strcat "gia tri x da nhap: " (rtos x ) "/nphai tinh theo co (2 + 5x)" ))
(princ)
(setq KQ (cos (+ 2 (* 5 x))))
)
)
(princ KQ)
(princ)
)
(defun c:ve (/ p r A B C D os k)
(setvar "cmdecho" 0)
(setq p (getpoint "/nNhap toa do diem A")
r (getdist "/nNhap r"))
(progn
(setq os (getvar "osmode"))
(setvar "osmode" 0)
(defun chuyen (p x y z)
(mapcar '+
p
(list x y z))
)
(setq A p
B (chuyen A r 0 0)
C (chuyen A r r 0)
D (chuyen A 0 r 0))
(command "line" A B C D A "")
(command "Arc" "c" A B D)
(command "Arc" "c" C D
)
(setq k (* 0.2 (distance A D))
A1 (chuyen A k k 0))
(command "BOUNDARY" A1 "")
(command "area" "o" "l")
(Princ (strcat "Dien tich hinh la " (rtos (* 2 (getvar "area")))))
(princ)
(setvar "osmode" os)
(setvar "cmdecho" 1)
)

;----------------------------------------------------------------------------
;;; COMMAND: RD
;;; This command read datafile & draw line with elevation
;;; Datafile structure : North East Height
;----------------------------------------------------------------------------
(if (not ai_utils)(load "ai_utils"))
(if (not my_utils)(load "my_utils"))

>>

;----------------------------------------------------------------------------
;;; COMMAND: RD
;;; This command read datafile & draw line with elevation
;;; Datafile structure : North East Height
;----------------------------------------------------------------------------
(if (not ai_utils)(load "ai_utils"))
(if (not my_utils)(load "my_utils"))
;----------------------------------------------------------------------------
(defun strltrim (s)
(cond
((eq s "") s)
((or(= " " (substr s 1 1))(= " " (substr s 1 1))) s)
(t (strltrim (substr s 2)))
)
)
(defun tabltrim (s)
(cond
((eq s "") s)
((or(= " " (substr s 1 1))(= " " (substr s 1 1))) (tabltrim (substr s 2)))
(t s)
)
)
;----------------------------------------------------------------------------
;; Subfunction for change 1 data-line to list
(defun linetopoint(line)
(setq y (read line)
line (tabltrim line)
line (strltrim line)
x (read line)
line (strltrim (tabltrim line))
z (read line)
)
(setq point (list x y z))
)
;;;-----------------------------------------------
;; Subfunction for read data from 1 file and change to list
(defun read_fs()
(setq dlist nil)
(setq datafile (GETFILED "TUAN - Select data-file " (GETVAR "dwgprefix") "*" 2))
(setq filename datafile)
(princ (strcat "\nPlease, wait!. READ & DRAW is reading data from " filename))
(if (setq f (open filename "r"))
(progn
(while (setq pl (read-line f))
(setq p (linetopoint pl) dlist (cons p dlist))
)
(close f)
)
)
(reverse dlist)
)
;---------------------------------------------------
;(defun C:van ( / li)
; (rd nil)
; (princ)

(defun c:van ( / li n i li htext)
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(Setq ts (tblsearch "STYLE" (GETVAR "TEXTSTYLE")))
(setq tsize (cdr(assoc '40 ts)))
(INITGET +3)
(if (= tsize 0)(setq h (getreal "\nHeigth of text :"))(setq h tsize))
(initget)
(setq tr (getreal "\nRotation of text <0>:"))
(if (= tr nil) (setq tr 0))
;-------------------------------------------
(initget "y n Y N")
(setq yn (getkword "\nDo you want to draw in 3D <y/n> ?<y>"))
(if (= yn nil)(setq yn "Y"))
(if (= (strcase yn) "N")(setq yn "N")(setq yn "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynl (getkword "\nDo you want to connect each to other <y/n> ?<y>"))
;(if (= ynl nil)(setq ynl "Y"))
;(if (= (strcase ynl) "N")(setq ynl "N")(setq ynl "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynd (getkword "\nDo you want to insert donut at each point <y/n> ?<y>"))
;(if (= ynd nil)(setq ynd "Y"))
;(if (= (strcase ynd) "N")(setq ynd "N")(setq ynd "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynC (getkword "\nDo you want to insert coconut at each point <y/n> ?<y>"))
;(if (= ynC nil)(setq ynC "Y"))
;(if (= (strcase ynC) "N")(setq ynC "N")(setq ynC "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynTD (getkword "\nDo you want to insert TD at each point <y/n> ?<y>"))
;(if (= ynTD nil)(setq ynTD "Y"))
;(if (= (strcase ynTD) "N")(setq ynTD "N")(setq ynTD "Y"))
;-------------------------------------------
;(initget "y n Y N")
;(setq ynCL (getkword "\nDo you want to insert CL at each point <y/n> ?<y>"))
;(if (= ynCL nil)(setq ynCL "Y"))
;(if (= (strcase ynCL) "N")(setq ynCL "N")(setq ynCL "Y"))
;-------------------------------------------
(setq tb (* h 0.50))
(setq li (read_fs) n (length li) i -1 ipold (list 0 0 0))
;(print li)
(ai_undo_on) ; Turn UNDO on
(command "_.UNDO" "_GROUP")
(setq o_osmode (getvar "osmode"))
(setvar "osmode" 0)
;(COMMAND "insert" "DONUT" "0,0")
(command)
(repeat n
(setq i (1+ i) ip (nth i li) htext (zrtos (last ip) 2))
(setq ip1 (list (car ip) (cadr ip) 0.00))
(setq zi (atof htext))
(cond
((and( > zi 1000)(< zi 2000))(command "insert" "bienbao" ip1 tb tb 0))
((and( > zi 2000)(< zi 3000))(command "insert" "buiram" ip1 tb tb 0))
((and( > zi 3000)(< zi 4000))(command "insert" "cayanqua" ip1 tb tb 0))
((and( > zi 4000)(< zi 5000))(command "insert" "caycothu" ip1 tb tb 0))
((and( > zi 5000)(< zi 6000))(command "insert" "caydua" ip1 tb tb 0))
((and( > zi 6000)(< zi 7000))(command "insert" "caylua" ip1 tb tb 0))
((and( > zi 7000)(< zi 8000))(command "insert" "caymia" ip1 tb tb 0))
((and( > zi 8000)(< zi 9000))(command "insert" "caynhon" ip1 tb tb 0))
((and( > zi 9000)(< zi 10000))(command "insert" "caythong" ip1 tb tb 0))
((and( > zi 10000)(< zi 11000))(command "insert" "caytre" ip1 tb tb 0))
((and( > zi 11000)(< zi 12000))(command "insert" "cocchuyen" ip1 tb tb 0))
((and( > zi 12000)(< zi 13000))(command "insert" "dadoclap" ip1 tb tb 0))
((and( > zi 13000)(< zi 14000))(command "insert" "g1" ip1 tb tb 0))
((and( > zi 14000)(< zi 15000))(command "insert" "g2" ip1 tb tb 0))
((and( > zi 15000)(< zi 16000))(command "insert" "g3" ip1 tb tb 0))
((and( > zi 16000)(< zi 17000))(command "insert" "g4" ip1 tb tb 0))
((and( > zi 17000)(< zi 18000))(command "insert" "g5" ip1 tb tb 0))
((and( > zi 18000)(< zi 19000))(command "insert" "gieng" ip1 tb tb 0))
((and( > zi 19000)(< zi 20000))(command "insert" "hoamau" ip1 tb tb 0))
((and( > zi 20000)(< zi 21000))(command "insert" "leduong" ip1 tb tb 0))
((and( > zi 21000)(< zi 22000))(command "insert" "moma" ip1 tb tb 0))
((and( > zi 22000)(< zi 23000))(command "insert" "rao" ip1 tb tb 0))
((and( > zi 23000)(< zi 24000))(command "insert" "raumau" ip1 tb tb 0))
((and( > zi 24000)(< zi 25000))(command "insert" "sl" ip1 tb tb 0))
((and( > zi 25000)(< zi 26000))(command "insert" "t1" ip1 tb tb 0))
((and( > zi 26000)(< zi 27000))(command "insert" "t2" ip1 tb tb 0))
((and( > zi 27000)(< zi 28000))(command "insert" "t3" ip1 tb tb 0))
((and( > zi 28000)(< zi 29000))(command "insert" "t4" ip1 tb tb 0))
((and( > zi 29000)(< zi 30000))(command "insert" "tuong" ip1 tb tb 0))
((and( > zi 30000)(< zi 31000))(command "insert" "tram" ip1 tb tb 0))
((and( > zi 31000)(< zi 32000))(command "insert" "trucaothe" ip1 tb tb 0))
((and( > zi 32000)(< zi 33000))(command "insert" "truco" ip1 tb tb 0))
((and( > zi 33000)(< zi 34000))(command "insert" "truden" ip1 tb tb 0))
((and( > zi 34000)(< zi 35000))(command "insert" "trudendoi" ip1 tb tb 0))
((and( > zi 35000)(< zi 36000))(command "insert" "trudien1" ip1 tb tb 0))
((and( > zi 36000)(< zi 37000))(command "insert" "truttin" ip1 tb tb 0))
((and( > zi 37000)(< zi 38000))(command "insert" "2tuong" ip1 tb tb 0))
((and( > zi 38000)(< zi 39000))(command "insert" "3tuong" ip1 tb tb 0))
((and( > zi 39000)(< zi 40000))(command "insert" "2rao" ip1 tb tb 0))
((and( > zi 40000)(< zi 41000))(command "insert" "3rao" ip1 tb tb 0))
((and( > zi 41000)(< zi 42000))(command "insert" "T1T2" ip1 tb tb 0))
((and( > zi 42000)(< zi 43000))(command "insert" "G1G2" ip1 tb tb 0))
((and( > zi 43000)(< zi 44000))(command "insert" "Cong" ip1 tb tb 0))
((and( > zi 44000)(< zi 45000))(command "insert" "Hangcay" ip1 tb tb 0))
((and( > zi 45000)(< zi 46000))(command "insert" "Ao" ip1 tb tb 0))
((and( > zi 46000)(< zi 47000))(command "insert" "Raokhac" ip1 tb tb 0))
((and( > zi 47000)(< zi 48000))(command "insert" "trudien2" ip1 tb tb 0))
((and( > zi 48000)(< zi 49000))(command "insert" "chanbc" ip1 tb tb 0))
((and( > zi 49000)(< zi 50000))(command "insert" "tuongkhac" ip1 tb tb 0))
((and( > zi 50000)(< zi 51000))(command "insert" "lekhac" ip1 tb tb 0))
)
;(setq ip (list (car ip) (cadr ip) 0)))
;(if (= ynl "Y")(if (> i 1)(command "line" ipold ip "")))
; (if (= ynd "Y")(command "insert" "donut" ip tb tb 0))
;(if (= ynC "Y")(command "insert" "coconut" ip tb tb 0))
;(if (= ynTD "Y")(command "insert" "TD" ip tb tb 0))
;(if (= ynCL "Y")(command "insert" "CL" ip tb tb 0))
(cond
((< zi 1000)(setq ri (- (atof htext) 00.0)))
((and( > zi 1000)(< zi 2000))(setq ri (- (atof htext) 1000.0)))
((and( > zi 2000)(< zi 3000))(setq ri (- (atof htext) 2000.0)))
((and( > zi 3000)(< zi 4000))(setq ri (- (atof htext) 3000.0)))
((and( > zi 4000)(< zi 5000))(setq ri (- (atof htext) 4000.0)))
((and( > zi 5000)(< zi 6000))(setq ri (- (atof htext) 5000.0)))
((and( > zi 6000)(< zi 7000))(setq ri (- (atof htext) 6000.0)))
((and( > zi 7000)(< zi 8000))(setq ri (- (atof htext) 7000.0)))
((and( > zi 8000)(< zi 9000))(setq ri (- (atof htext) 8000.0)))
((and( > zi 9000)(< zi 10000))(setq ri (- (atof htext) 9000.0)))
((and( > zi 10000)(< zi 11000))(setq ri (- (atof htext) 10000.0)))
((and( > zi 11000)(< zi 12000))(setq ri (- (atof htext) 11000.0)))
((and( > zi 12000)(< zi 13000))(setq ri (- (atof htext) 12000.0)))
((and( > zi 13000)(< zi 14000))(setq ri (- (atof htext) 13000.0)))
((and( > zi 14000)(< zi 15000))(setq ri (- (atof htext) 14000.0)))
((and( > zi 15000)(< zi 16000))(setq ri (- (atof htext) 15000.0)))
((and( > zi 16000)(< zi 17000))(setq ri (- (atof htext) 16000.0)))
((and( > zi 17000)(< zi 18000))(setq ri (- (atof htext) 17000.0)))
((and( > zi 18000)(< zi 19000))(setq ri (- (atof htext) 18000.0)))
((and( > zi 19000)(< zi 20000))(setq ri (- (atof htext) 19000.0)))
((and( > zi 20000)(< zi 21000))(setq ri (- (atof htext) 20000.0)))
((and( > zi 21000)(< zi 22000))(setq ri (- (atof htext) 21000.0)))
((and( > zi 22000)(< zi 23000))(setq ri (- (atof htext) 22000.0)))
((and( > zi 23000)(< zi 24000))(setq ri (- (atof htext) 23000.0)))
((and( > zi 24000)(< zi 25000))(setq ri (- (atof htext) 24000.0)))
((and( > zi 25000)(< zi 26000))(setq ri (- (atof htext) 25000.0)))
((and( > zi 26000)(< zi 27000))(setq ri (- (atof htext) 26000.0)))
((and( > zi 27000)(< zi 28000))(setq ri (- (atof htext) 27000.0)))
((and( > zi 28000)(< zi 29000))(setq ri (- (atof htext) 28000.0)))
((and( > zi 29000)(< zi 30000))(setq ri (- (atof htext) 29000.0)))
((and( > zi 30000)(< zi 31000))(setq ri (- (atof htext) 30000.0)))
((and( > zi 31000)(< zi 32000))(setq ri (- (atof htext) 31000.0)))
((and( > zi 32000)(< zi 33000))(setq ri (- (atof htext) 32000.0)))
((and( > zi 33000)(< zi 34000))(setq ri (- (atof htext) 33000.0)))
((and( > zi 34000)(< zi 35000))(setq ri (- (atof htext) 34000.0)))
((and( > zi 35000)(< zi 36000))(setq ri (- (atof htext) 35000.0)))
((and( > zi 36000)(< zi 37000))(setq ri (- (atof htext) 36000.0)))
((and( > zi 37000)(< zi 38000))(setq ri (- (atof htext) 37000.0)))
((and( > zi 38000)(< zi 39000))(setq ri (- (atof htext) 38000.0)))
((and( > zi 39000)(< zi 40000))(setq ri (- (atof htext) 39000.0)))
((and( > zi 40000)(< zi 41000))(setq ri (- (atof htext) 40000.0)))
((and( > zi 41000)(< zi 42000))(setq ri (- (atof htext) 41000.0)))
((and( > zi 42000)(< zi 43000))(setq ri (- (atof htext) 42000.0)))
((and( > zi 43000)(< zi 44000))(setq ri (- (atof htext) 43000.0)))
((and( > zi 44000)(< zi 45000))(setq ri (- (atof htext) 44000.0)))
((and( > zi 45000)(< zi 46000))(setq ri (- (atof htext) 45000.0)))
((and( > zi 46000)(< zi 47000))(setq ri (- (atof htext) 46000.0)))
((and( > zi 47000)(< zi 48000))(setq ri (- (atof htext) 47000.0)))
((and( > zi 48000)(< zi 49000))(setq ri (- (atof htext) 48000.0)))
((and( > zi 49000)(< zi 50000))(setq ri (- (atof htext) 49000.0)))
((and( > zi 50000)(< zi 51000))(setq ri (- (atof htext) 50000.0)))
)
(if (> (atof htext) 1000)(setq htext (zrtos ri 2)))
(if (= yn "N")(setq ip (list (car ip) (cadr ip) 0.00))(setq ip (list (car ip) (cadr ip) ri)))
(print ip)
(if (= tsize 0)
(COMMAND "text" "j" "c" ip h tr htext)
(COMMAND "text" "j" "c" ip tr htext)
)
(command "insert" "donut" ip tb tb 0) ;(neu su dung YN donut thi xoa ca hang nay)
;(setq ipold ip)
)
(setvar "osmode" o_osmode)
(command "_.UNDO" "_E")
(ai_undo_off)
(princ "\nThank you for using this command")
(princ)
)
;;;--------------------------------------------------------------------------------
(princ " READ & DRAW loaded.")
(princ )







Mình có lisp phun điểm này nhờ các Anh/Chị,sửa dùm với.
Lisp chạy tốt nhưng bị hạn chế là chỉ chạy được tới 99,xxx. Chỉ được 2 số nguyên tới 100,xxx là ko hiểu
Nhờ các Anh/ Chị sửa dùm
Lệnh: RD
chiều cao text:
Góc quay(0):
Do you want to draw in 3D (y/n)?
Thêm dòng này: Số thập phân :

copy lisp vào support của Cad và phải có dấu chấm vàng trong bản vẽ bên dưới thì lisp mới chạy được
Dưới đây là file TxT và file mẫu do lisp chạy được.http://www.cadviet.c.../73751_text.dwg
http://www.cadviet.c...751_datlanh.txt

Thân bác phamthanhbinh,
Đúng là em có chút sơ suất khi đã không giải thích cụ thể. Lô đất của em ban đầu như thế này ạ!
http://nt1.upanh.com/b2.s32.d1/3582aa41af1fd9ef3d9c337448014f65_52433831.1.700x0.jpg
Em đã có xem một vài lisp về thống kê đỉnh nhưng đều không đạt yêu cầu. Em thấy có mỗi 1 lisp đánh số thứ tự bằng tay như thế này thôi ạ.

(defun c:stt (/ oldPref oldSuf...

Thân bác phamthanhbinh,
Đúng là em có chút sơ suất khi đã không giải thích cụ thể. Lô đất của em ban đầu như thế này ạ!
http://nt1.upanh.com/b2.s32.d1/3582aa41af1fd9ef3d9c337448014f65_52433831.1.700x0.jpg
Em đã có xem một vài lisp về thống kê đỉnh nhưng đều không đạt yêu cầu. Em thấy có mỗi 1 lisp đánh số thứ tự bằng tay như thế này thôi ạ.

(defun c:stt (/ oldPref oldSuf oldStart curStr newNum
actDoc actSp oldEcho oldSize *error*)
(defun *error* (msg)
(setvar "CMDECHO" oldEcho)
(princ)
); end *error*

(vl-load-com)
(if(not num:Size)(setq num:Size(getvar "DIMTXT")))
(if(not num:Pref)(setq num:Pref ""))
(if(not num:Suf)(setq num:Suf ""))
(if(not num:Num)(setq num:Num 1))
(setq oldPref num:Pref
oldSuf num:Suf
oldStart num:Num
oldSize num:Size
actDoc(vla-get-ActiveDocument
(vlax-get-acad-object))
oldEcho(getvar "CMDECHO")
); end setq
(setvar "CMDECHO" 0)
(if(=(vla-get-ActiveSpace actDoc)1)
(setq actSp(vla-get-ModelSpace actDoc))
(setq actSp(vla-get-PaperSpace actDoc))
); end if
(setq num:Size
(getreal
(strcat "\nText size <"(rtos num:Size)">: ")))
(if(null num:Size)(setq num:Size oldSize))
(setq num:Pref
(getstring T
(strcat "\nPrefix: <"num:Pref">: ")))
(if(= "" num:Pref)(setq num:Pref oldPref))
(if(= " " num:Pref)(setq num:Pref ""))
(setq num:Suf
(getstring T
(strcat "\nSuffix: <"num:Suf">: ")))
(if(= "" num:Suf)(setq num:Suf oldSuf))
(if(= " " num:Suf)(setq num:Suf ""))
(setq num:Num
(getint
(strcat "\nStarting number <"(itoa num:Num)">: ")))
(if(null num:Num)(setq num:Num oldStart))
(princ "\n<<< Insert numbers or press Esc to quit >>> ")
(while T
(setq curStr(strcat num:Pref(itoa num:Num)num:Suf)
newNum(vla-AddText actSp
curStr (vlax-3d-point '(0.0 0.0 0.0)) num:Size))
(vla-put-Alignment newNum acAlignmentMiddleCenter)
(command "_.copybase"(trans '(0.0 0.0 0.0)0 1)(entlast)"")
(command "_.erase" (entlast) "")
(command "_.pasteclip" pause)
(setq num:Num(1+ num:Num))
); end while
(princ)
); end of c:stt
(princ "\n***Lenh STT.*** ")

Mong bác giúp em bổ sung thêm yêu cầu về chiều dài và diện tích ạ.
Em cảm ơn bác ạ!

bạn dùng thử cái này xem sao

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=213751&st=0&#entry213751
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=199638&st=0&#entry199638
;; free lisp from cadviet.com
;;; this lisp was downloaded from...

bạn dùng thử cái này xem sao

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=213751&st=0&#entry213751
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=63922&pid=199638&st=0&#entry199638
;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=13203&st=3100
;; free lisp from cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
(setq p1 (polar p0 (dtr a) r))
(command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
(setq i 0
L nil
)
(vl-load-com)
(repeat (fix (+ (vlax-curve-getEndParam e) 1))
(setq L (append L (list (vlax-curve-getPointAtParam e i))))
(setq i (1+ i))
)
L
)
;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
(setq i 0)
(foreach pt Lst
(if (equal pt0 pt 0.001)
(setq rt i))
(setq i (1+ i)))
(append (append (member (nth rt Lst) Lst)
(cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
(list (nth rt Lst)))
)
;;;New Layer
(defun newlayer(a b c d)
(if (not (tblsearch "layer" a))
(command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
(entmake (list (cons 0 "TEXT")
(cons 7 (getvar "textstyle"))
(cons 1 txt)
(cons 10 p)
(cons 11 p)
(cons 40 h)
(cons 72 1)
(cons 73 2)
(if k (cons 51 (DTR 18)) (cons 51 0))
)
)
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
(setq SS (ssadd))
(ssadd e SS)
(while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1 (e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
(if (= e nil)
(setq ss (collect (entnext)))
(progn (setq ss (collect e)) (ssdel e ss))
)
)
;;;-------------------------------------------------------------------------------
;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
(setq
p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
p2 (polar p1 0 (* 7 h))
p3 (polar p2 0 (* 10 h))
p4 (polar p3 0 (* 9 h))
p4 (polar p4 (* 0.5 pi) h)
pL (list p1 p2 p3 p4)
i 0
)
(repeat 4
(wtxtMC (nth i txtL) (nth i pL) h t)
(setq i (1+ i))
)
)
;;;-------------------------------------------------------------------------------
;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:TD (/ h p et p0 p00 p01 p02 pt pvL pvL1 n j pv num txtL ss bn ntp p11 p12 p13 p14)
(setvar "cmdecho" 0)
;;;New layer check
(newlayer "kichthuoc" 7 "continuous" "default")
(newlayer "stt" 1 "continuous" "default")
(newlayer "bangtd" 7 "continuous" "default")
;;;GET TEXT HEIGHT
(if (not h0) (setq h0 1))
(setq h (getreal (strcat "\nChon chieu cao text <" (rtos h0) ">:")))
(if (not h) (setq h h0) (setq h0 h))
;;;GET DECIMAL PRECISION
(if (not ntp0) (setq ntp0 2))
(setq ntp (getint (strcat "\nSo chu so thap phan <" (itoa ntp0) ">:")))
(if (not ntp) (setq ntp ntp0) (setq ntp0 ntp))
;;;GET CIRCLE RADIUS
(if (not cr0) (setq cr0 0.3))
(setq cr (getreal (strcat "\nNhap ban kinh vong tron <" (rtos cr0) ">:")))
(if cr (setq cr0 cr))
;;;PICK & BASE POINT
(initget "Y")
(setq save (getkword "\nBan co muon luu file? < Y / Enter for No >:"))
(setq oldos (getvar "osmode")
pdau (getpoint "\nPick diem dau tien (so thu tu = M1): " )
)
;(while pdau
(setq p (getpoint "\nPick 1 diem giua mien kin:")
pvL nil pvL1 nil)
(command "boundary" p "")
(setq et (entlast)
pvL1 (reverse (getvert et)))
(redraw et 3)
(setq p00 (getpoint "\nDiem dat Bang TDGR:"))
(initget "T t N n")
(setq chieu (getkword "\nLua chon chieu ghi toa do < T/N >"))
(command "erase" et "")
(setq p0 p00
p01 (polar p00 (* 1.5 pi) (* h 3))
pvL (relist pdau pvL1)
n (length pvL)
p02 (polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
)
(setvar "osmode" 0)
;;;HEADER
(setvar "CLAYER" "bangtd")
(linepx p0 (* 32 h))
(command "copy" "L" "" "m" p00 p01 "")
(setq Lkqua nil)
(command "style" "CadViet" ".VnArialH" "" "" "" "" "")
(wtxtMC "B&#182;ng k&#170; t&#228;a &#174;&#233; v&#181; kho&#182;ng c&#184;ch"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 4 h))
(* 1.2 h) nil)
(wtxtMC "H&#214; t&#228;a &#174;&#233; VN - 2000"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
(* 1.2 h) nil)
(txt1 (setq Lkq (list "TT" "Y (m)" "X (m)" "S (m)")))
(setq Lkqua (append Lkqua (list Lkq)))
(setq p0 (polar p0 (* 1.5 pi) (* 3 h)))
;;;MAKE RECORDS
(if (or (= chieu "N") (= chieu "n")) (setq pvL (reverse pvL)) )
(setq j 0
pt nil)
(repeat n
(setq
pv (nth j pvL)
num (itoa (1+ j))
num (strcat "M" num)
)
(if pt
(setq S (rtos (distance pt pv) 2 ntp))
(setq S "")
)
(setq
txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
Lkqua (append Lkqua (list txtL))
)
(txt2 txtL)
(setq p11 (polar p0 (* 1.5 pi) (* 2.5 h)))
(setq P12 (polar p11 0 (* 25 h)))
(setq P13 (polar p11 0 (* 31 h)))
(setq P14 (polar p11 0 (* 32 h)))
(command "LINE" p11 p12 "")
(command "LINE" p13 p14 "")
(setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)
(command "LINE" p11 p14 "")
(linepy p00 (- (distance p00 (polar p0 (* 1.5 pi) (* 0.5 h)) )))
(command "copy" "L" "" "m" p0
(list (+ (car p0) (* 4 h)) (cadr p0))
(list (+ (car p0) (* 14 h)) (cadr p0))
(list (+ (car p0) (* 24 h)) (cadr p0))
(list (+ (car p0) (* 32 h)) (cadr p0))
"")
;;;WRITE POINT NAME
(setvar "CLAYER" "stt")
(setq j 0)
(repeat (1- n)
(setq
pv (nth j pvL)
num (itoa (1+ j))
num (strcat "M" num)
)
(wtxtMC num (polar pv 0 h) h t)
(command "circle" pv cr0)
(command "HATCH" "solid" "L" "")
(command "erase" vtron "")
(setq j (1+ j))
)
;;;GHI CANH THUA
(setvar "CLAYER" "kichthuoc")
(ghicanh)
;;;FINISH
(savef)
(setvar "osmode" oldos)
;(setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
;;; )
(setvar "cmdecho" 1)
(princ)
)
;;;-------------------------------------------------------------------------------
(defun savef()
(if save
(progn
(setq file (open (setq tenfile (strcat (getvar "dwgprefix")
(vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))
(foreach line Lkqua
(setq line1 "")
(foreach it line
(setq line1 (strcat line1 " " it)))
(write-line line1 file)
)
(close file)
(princ (strcat "\nDa luu thanh file " tenfile))
)
)
)
;;;PHAN BO SUNG
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a )
;;;Entmake text S at p with angle A - Top Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 2)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a )
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 3)
)
)
)
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a )
;;;Entmake text S at p with angle A - Bottom Center
(if (/= p nil)
(entmake (list
(cons 0 "TEXT")
(cons 62 2)
(cons 10 p)
(cons 40 h)
(cons 1 S)
(cons 50 a )
(cons 41 0.7)
(cons 7 (getvar "textstyle"))
(cons 72 1)
(cons 11 p)
(cons 73 1)
)
)
)
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp mp1)
(setq
i 0
k (1- (length pvL))
)
(repeat k
(setq
p1 (nth i pvL)
p2 (nth (+ i 1) pvL)
dist (distance p1 p2)
rad (angle p1 p2)
x_mp (* (+ (car p1) (car p2)) 0.5)
y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
mp (list x_mp y_mp)
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
)
(if (and (> rad (* 0.5 pi)) (<= rad (* 1.5 pi)))
(progn
(setq rad (+ rad pi))
;(Text_canh_TCA (rtos dist 2 2) mp rad)
)
;(Text_canh_BCA (rtos dist 2 2) mp rad)
)
(setq mp1 (polar mp (angle p mp) (* 2 h)) )
(command "DIMALIGNED" p1 p2 mp1)
(setq i (1+ i))
)
;; repeat k;
)
;;;--------------------------



cái này mình tìm trên diễn đàn và có nhờ Thiep sửa lại đôi chút bạn xem có được ko

Xin trả lời bạn một số ý:

1- Mục đích của diễn đàn là để nhiều người cùng tham gia thảo luận và học hỏi lẫn nhau. Theo ssg, nếu không cần thiết lắm, mọi vấn đề chuyên môn bạn cứ nêu lên diễn đàn. Nếu có vấn đề gì không tiện nêu công khai, bạn có thể liên lạc với ssg qua email: maickkha@yahoo.com.vn

2- Các hình khối tương tự như của bạn, dùng lệnh loft...

Xin trả lời bạn một số ý:

1- Mục đích của diễn đàn là để nhiều người cùng tham gia thảo luận và học hỏi lẫn nhau. Theo ssg, nếu không cần thiết lắm, mọi vấn đề chuyên môn bạn cứ nêu lên diễn đàn. Nếu có vấn đề gì không tiện nêu công khai, bạn có thể liên lạc với ssg qua email: maickkha@yahoo.com.vn

2- Các hình khối tương tự như của bạn, dùng lệnh loft là hợp lý. Bạn có thể vào Help để thấy các điều kiện sử dụng:

http://www.cadviet.com/upfiles/loft_hep.jpg

Cụ thể, 2 cross section của bạn không bảo đảm yêu cầu (gồm line + spline). Mình đã chuyển cái spline thành pline bằng lisp. Sau đó joint với các line còn lại thành 1 pline duy nhất -> bảo đảm điều kiện của loft. Nếu phức tạp hơn, có thể tạo solid từng phần rồi dùng các lệnh union, subtract, intersect để xử lý.

3- Lisp convert spline -> pline mình đã post ở đâu đó rồi. Tìm lại cũng... mệt, post lại ở đây:


4- Khả năng 3D của AutoCAD có hạn, bạn có nhu cầu làm việc nhiều với 3D phức tạp thì nên nghiên cứu các phần mềm chuyên 3D: SolidWorks, Inventor, Rhino... Hoặc cao cấp hơn (và có nhu cầu đối với phần gia công - CAM) thì: MasterCAM, Pro/E, Catia...
Bản thân ssg cũng rất ngại khi phải làm việc nhiều với 3D phức tạp trong CAD. Nhiều mô hình phức tạp mình phải đơn giản hoá bớt đi. Trường hợp bất khả kháng thì phải dùng các phần mềm khác để xử lý và có thể trả kết quả về cho AutoCAD.
Ssg mới bắt đầu tiếp cận SolidWorks nhưng thấy nó rất hay, hoàn toàn đáp ứng được nhu cầu hiện tại của mình (và các trường hợp tương tự như của bạn). Bạn có thể tham khảo ở đây, và nếu có thể thì tham gia cùng anh em cho có khí thế:

http://www.cadviet.com/forum/index.php?sho...amp;#entry23891

hihi lsp anh Binh viết hay quá, nhưng hình như nhầm 1 chỗ thì phải ^^, nhoc nhập 1990 thì cuối cùng nó kiu là block 10 ^^ ko có
nhoc mò mẫn thử đọc ko hỉu lsp vì cao quá ^^ nhưng sữa đại như vầy thì đc

;; free lisp from cadviet.com
;;; this lisp was downloaded from...

hihi lsp anh Binh viết hay quá, nhưng hình như nhầm 1 chỗ thì phải ^^, nhoc nhập 1990 thì cuối cùng nó kiu là block 10 ^^ ko có
nhoc mò mẫn thử đọc ko hỉu lsp vì cao quá ^^ nhưng sữa đại như vầy thì đc

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68603&pid=224775&st=0&#entry224775

(defun c:pht (/ bln a b c d tg gt t1 t2 t3)
(setq year (getint "\n Hay nhap nam sinh du 4 chu so: ")
GT (getint "\n Hay nhap gioi tinh chu nha <1=Nam; 2=nu>: "))
(setq a (atoi (substr (itoa year) 1 1))
b (atoi (substr (itoa year) 2 1))
c (atoi (substr (itoa year) 3 1))
d (atoi (substr (itoa year) 4 1))
Tg (+ a b c d) )
;;;;;;;;;;;;;;;;;;;
(defun ssu (a / a1 a2 t1)
(if (> a 9);sua 9 thanh 10
(progn
(setq t1 (itoa a)
a1 (atoi (substr t1 1 1))
a2 (atoi (substr t1 2 1))
t2 (+ a1 a2) )
(if (> t2 9); sua 9 thanh 10
(ssu t2) )
)
)
t2
)
;;;;;;;;;;;;;;;;;;
(setq tong (ssu tg))
(if (= gt 1)
(setq bln (itoa (- 11 t2)))
(progn
(setq t3 (+ 4 t2))
(if (> t3 9)
(setq t3 (ssu t3))
)
(setq bln (itoa t3))
)
)
(alert (strcat "\n Ten block can chen la " bln))
(command "insert" bln (getpoint "\n Nhap diem chen block") 1 1 0)
)

nhoc xin mạn phép pst bài ở đây lun hen ^^, anh Ket xem có phải vậy ko anh

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68603&pid=224799&st=0&#entry224799
;ns : nam sinh, string hoac so (~Int)
;gt : gioi tinh, string hoac so (~Int)
;(batquai 1987 1), (batquai "1987" "2") => tra ve ten Block
(defun c:pht (/ ns gt)
(setq ns (getint...

nhoc xin mạn phép pst bài ở đây lun hen ^^, anh Ket xem có phải vậy ko anh

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68603&pid=224799&st=0&#entry224799
;ns : nam sinh, string hoac so (~Int)
;gt : gioi tinh, string hoac so (~Int)
;(batquai 1987 1), (batquai "1987" "2") => tra ve ten Block
(defun c:pht (/ ns gt)
(setq ns (getint "\nNhap nam sinh of you:"))
(setq gt (getint "\nChon gioi tinh 1 la boy 2 la girl:"))
(princ "\n")
(princ "quai so cua ban la: ")
(princ (batquai ns gt))
(princ)
)
(defun batquai(ns gt / tst)
(defun tst(str / kq)(vl-load-com)
(while (> (setq kq (apply '+ (mapcar '(lambda(x)(atoi (chr x))) (vl-string->list str)))) 9)
(setq str (itoa kq))
) kq
)
(itoa (tst (itoa (abs (+ (tst (vl-princ-to-string ns)) (if (= (vl-princ-to-string gt) "1") -11 4))))))
)

nhoc xin đóng góp cách thổ rân thế này ^^, 9 cái đó bạn dùng lệnh writeblock write từng cái cái lưu trong đường dẫn
(C:\program files\autodesk\autocad autocad2xxx\support\).cách này nếu bạn chỉ dùng 1 máy, mà mở bất kỳ bản vẽ nào bạn dùng lsp để gọi nó cũng ra, ko phải mở đúng bản vẽ bạn đã vẽ sẵn 9 cái block đó mới xài đc.
Còn nếu đi máy khác thì chắc như bạn autocadlisp nói phải...

nhoc xin đóng góp cách thổ rân thế này ^^, 9 cái đó bạn dùng lệnh writeblock write từng cái cái lưu trong đường dẫn
(C:\program files\autodesk\autocad autocad2xxx\support\).cách này nếu bạn chỉ dùng 1 máy, mà mở bất kỳ bản vẽ nào bạn dùng lsp để gọi nó cũng ra, ko phải mở đúng bản vẽ bạn đã vẽ sẵn 9 cái block đó mới xài đc.
Còn nếu đi máy khác thì chắc như bạn autocadlisp nói phải vẽ nó trong lsp lun, mà vẽ cái này trong lsp cũng mệt mỏi ah ^^. mạn phép anh Bình sữa dùm bạn ấy chỗ nhầm xíu trong lsp của anh

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68603&pid=224775&st=0&#entry224775

(defun c:pht (/ bln a b c d tg gt t1 t2 t3)
(setq year (getint "\n Hay nhap nam sinh du 4 chu so: ")
GT (getint "\n Hay nhap gioi tinh chu nha <1=Nam; 2=nu>: "))
(setq a (atoi (substr (itoa year) 1 1))
b (atoi (substr (itoa year) 2 1))
c (atoi (substr (itoa year) 3 1))
d (atoi (substr (itoa year) 4 1))
Tg (+ a b c d) )
;;;;;;;;;;;;;;;;;;;
(defun ssu (a / a1 a2 t1)
(if (> a 10);sua 9 thanh 10
(progn
(setq t1 (itoa a)
a1 (atoi (substr t1 1 1))
a2 (atoi (substr t1 2 1))
t2 (+ a1 a2) )
(if (> t2 10); sua 9 thanh 10
(ssu t2) )
)
)
t2
)
;;;;;;;;;;;;;;;;;;
(setq tong (ssu tg))
(if (= gt 1)
(setq bln (itoa (- 11 t2)))
(progn
(setq t3 (+ 4 t2))
(if (> t3 9)
(setq t3 (ssu t3))
)
(setq bln (itoa t3))
)
)
(alert (strcat "\n Ten block can chen la " bln))
(command "insert" bln (getpoint "\n Nhap diem chen block") 1 1 0)
)

em sữa rùi nè hihi

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68603&pid=224799&st=0&#entry224799
;ns : nam sinh, string hoac so (~Int)
;gt : gioi tinh, string hoac so (~Int)
;(batquai 1987 1), (batquai "1987" "2") => tra ve ten Block
(defun c:pht (/ ns gt)
(setq ns (getint "\nNhap nam sinh of you:"))
(setq gt (getint...

em sữa rùi nè hihi

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=68603&pid=224799&st=0&#entry224799
;ns : nam sinh, string hoac so (~Int)
;gt : gioi tinh, string hoac so (~Int)
;(batquai 1987 1), (batquai "1987" "2") => tra ve ten Block
(defun c:pht (/ ns gt)
(setq ns (getint "\nNhap nam sinh of you:"))
(setq gt (getint "\nChon gioi tinh 1 la boy 2 la girl:"))
(setq ketqua (batquai ns gt))
(alert (strcat "\n Ten block can chen la " ketqua))
(command "insert" ketqua (getpoint "\n Nhap diem chen block") 1 1 0)
)
(defun batquai(ns gt / tst)
(defun tst(str / kq)(vl-load-com)
(while (> (setq kq (apply '+ (mapcar '(lambda(x)(atoi (chr x))) (vl-string->list str)))) 9)
(setq str (itoa kq))
) kq
)
(itoa (tst (itoa (abs (+ (tst (vl-princ-to-string ns)) (if (= (vl-princ-to-string gt) "1") -11 4))))))
)

Chào study_forever
Tiếng Việt mình, cụm từ "Đã thế" đuợc dùng trong bối cảnh nào vậy ta ?

Hàm (defun mid (ent / p1 p2) ..) bạn post lên không trả về tâm của 1 đối tuợng đâu !
Thưc chất là nó trả về tâm của hình chử nhật bao quanh đối tuợng đó.
"Đã thế" : tâm của 1 cung tròn (ARC) ở đâu ?
"Đã thế" : tâm của 1 đuờng kích thuớc (Dimension) ở đâu ?

>>

Chào study_forever
Tiếng Việt mình, cụm từ "Đã thế" đuợc dùng trong bối cảnh nào vậy ta ?

Hàm (defun mid (ent / p1 p2) ..) bạn post lên không trả về tâm của 1 đối tuợng đâu !
Thưc chất là nó trả về tâm của hình chử nhật bao quanh đối tuợng đó.
"Đã thế" : tâm của 1 cung tròn (ARC) ở đâu ?
"Đã thế" : tâm của 1 đuờng kích thuớc (Dimension) ở đâu ?
.....
Khái niệm "tâm 1 vật nào đó" mà bạn Post ở trên cần phải hiểu là tâm của hình chử nhật bao quanh đối tuợng đó.

"Đã thế" :bạn chạy thử LISP này xem có Đã đã đã ............. hôn ?

mình thấy cũng hay, chắc có lúc cũng xài, kím dùm bạn ^^ nhưng ko pit có đúng ý bạn ko, ko đc là elisp nhưng là hình tròn mình thấy cũng đẹp, tọa độ x, y đã đc sữa theo vn-2000 , có cái ko chọn font giống cái cũ đc, số lẽ đằng sau do mình thiết lập trong unit của cad

;; free lisp from cadviet.com

>>

mình thấy cũng hay, chắc có lúc cũng xài, kím dùm bạn ^^ nhưng ko pit có đúng ý bạn ko, ko đc là elisp nhưng là hình tròn mình thấy cũng đẹp, tọa độ x, y đã đc sữa theo vn-2000 , có cái ko chọn font giống cái cũ đc, số lẽ đằng sau do mình thiết lập trong unit của cad

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=67229

;; free lisp from cadviet.com
(prompt"\n - THONG KE TOA DO\n")
----------------------------------------------
(defun C:TTD ()
(setvar "cmdecho" 0 )
(command "Undo" "Begin")
(setq om (getvar "osmode"))
(if (not h) (setq h 1))
(setq caot1 (getreal (strcat "\nCao text < " (rtos h 2 2) " >:")))
(if caot1 (setq h caot1))
(setq tapx '() tapy '() stt '())
(setq bit1 (cond (bit1) ("Yes")))
(initget "Yes No")
(setq Tmp1 (strcat "\nTu dong ghi ten nut? <" bit1 ">: ")
bit1 (cond ((getkword Tmp1)) (bit1)))
(if (eq bit1 "Yes")
(progn
(setq ten (getstring "\nTen Nut:"))
(if (not i) (setq i 1))
(setq i1 (getreal (strcat"\nSTT cua nut bat dau < " (rtos i 2 0) " >: ")))
(if i1 (setq i i1))
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" 0)
(setq DX (getpoint (strcat"\nDiem dat text thu "(rtos (+ k 1) 2 0)"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text "(rtos (+ k 1) 2 0)"") Dx)
angr (angle Dx Dy)
angd (/ (* 180 angr) pi)
y (rtos (car D1) 2 4)
x (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Cadr D1) 2 4))
TY (strcat "Y:"(rtos (Car D1) 2 4))
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
N (strcat ten (rtos k 2 0))
stt (append stt (list N))
);setq
(setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BL" D2 h angd tX)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (+ (* 1.5 h ) dt)) (+ (* 1.5 h) dt)
"text" "m" (polar PT3 angr (+ (* 1.5 h) dt )) h angd N
"CECOLOR" 8
"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt)
);command
(setvar "CECOLOR" lacol)
);progn
);if
(if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BR" D2 h (+ angd 180) tx)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt)
"text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N
"CECOLOR" 8
"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt)
);command
(setvar "CECOLOR" lacol)
);progn
);if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn
);if
(if (eq bit1 "No")
(progn
(setvar "osmode" 125)
(setq lacol (getvar "CEColor") i 1 k (- i 1))
(While
(setq D1 (getpoint (strcat"\nPick diem thu "(rtos (+ k 1) 2 0)"")))
(Progn
(setvar "osmode" 0)
(progn
(setq LOOP T)
(while (= LOOP T)
(while (null (setq ten (nentsel "\nChon mot text lam ten nut: ")))
(princ "\nChua tim thay doi tuong la text, chon lai !"));while
(setq Source_text (entget (car ten)))
(if (or (= (cdr (assoc '0 Source_text)) "TEXT")
(= (cdr (assoc '0 Source_text)) "MTEXT")
(= (cdr (assoc '0 Source_text)) "ATTRIB"));or
(progn
(setq N (cdr (assoc 1 Source_text)))
(setq LOOP nil));progn
(progn
(princ "Phai chon mot text lam ten nut !")
(setq LOOP T));progn
)if
);while
);progn
(setq DX (getpoint (strcat"\nDiem dat text cua nut "N"") D1)
DY (getpoint (strcat"\nHuong goc nghieng cua text") Dx)
angr (angle Dx Dy))
(setq angd (/ (* 180 angr) pi)
y (rtos (car D1) 2 4)
x (rtos (cadr D1) 2 4)
TX (strcat "X:"(rtos (Cadr D1) 2 4))
TY (strcat "Y:"(rtos (Car D1) 2 4))
tapx (append tapx (list x))
tapy (append tapy (list y))
k (+ 1 k)
stt (append stt (list N))
);setq
(setq dt (* 0.5 (- (strlen N) 2) h));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if (>= (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BL" D2 h angd tX)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (- angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT4 PT5 h ty
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt)
"text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h angd N
"CECOLOR" 8
"circle" (polar PT3 angr (+(* 1.5 h) dt)) (+ (* 1.35 h) dt)
);command
(setvar "CECOLOR" lacol)
);progn
);if
(if (< (car DY) (car DX))
(progn
(setq D2 (polar Dx angr (* 0.7 h)))
(command "text" "BR" D2 h (+ angd 180) tx)
(setq TB (textbox (entget(entlast)))
LC (car TB)
RC (cadr TB)
di (distance LC RC)
PT3 (polar D2 angr (+ di (* 0.4 h)))
pt4 (polar D2 (+ angr (* pi 0.5)) (* 1.35 h))
pt5 (polar pt4 angr di)
C (polar PT3 0 (* 1.5 h))
);setq
(command "text" "F" PT5 PT4 h TY
"pline" D1 DX PT3 ""
"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.5 h) dt)
"text" "m" (polar PT3 angr (+ (* 1.5 h) dt)) h (+ angd 180) N
"CECOLOR" 8
"circle" (polar PT3 angr (+ (* 1.5 h) dt)) (+ (* 1.35 h) dt)
);command
(setvar "CECOLOR" lacol)
);progn
);if
);progn
(setvar "osmode" 125)
);while
(setq i (+ k 1))
);progn
);if
(setq bit (cond (bit) ("Yes")))
(initget "Yes No")
(setq Tmp (strcat "\nXuat bang toa do? <" bit ">: ")
bit (cond ((getkword Tmp)) (bit)))
(if (eq bit "Yes")
(progn
(setq di (- di (* 0.4 h))
kc (* 2 di)
PT (getpoint"\nVi tri dat bang")
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
p1 (list (car PT) (+ (cadr PT)(* 2 h)))
p2 (list (car PTC) (+ (cadr PTC)(* 2 h)))
p3 (list (car p1) (+ (cadr p1)(* 2 h)))
p4 (list (car p2) (+ (cadr p2)(* 2 h)))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
p11 (list (+ (/ di 2) (car p1)) (+ (* 1.1 h) (cadr p1)))
p22 (list (+ di (/ di 2) (- 0 h) (car p11)) (- (cadr p11) (* 0.1 h)))
p33 (list (+ kc (- h h h h) (car p22)) (cadr p22))
L1 (list (+ di (car p3))(cadr p3))
L2 (list (+ kc (- 0 h h)(car L1))(cadr L1))
PTB (list (+ (- (* 2 h)) (* 0.5 (+ (* 2 kc) di)) (car PT)) (+ (cadr P3) (* 1.8 h)))
n (length tapx)
k 0
);setq
(setvar "osmode" 0)
(command "CECOLOR" 3 "line" p1 p2 "" "line" p3 p4 "" "CECOLOR" 2
"text" "m" p11 h 0 "&#167;i&#211;m"
"text" "m" p22 h 0 "T&#228;a &#174;&#233; X"
"text" "m" p33 h 0 "T&#228;a &#174;&#233; Y"
"text" "m" pTB (* 1.3 h) 0 "B&#182;ng T&#228;a &#167;&#233; &#167;i&#211;m")
(while (< k n)
(setq xx (nth k tapx) yy (nth k tapy) tstt(nth k stt))
(command "CECOLOR" 2
"text" "m" PTD h 0 tstt
"text" "m" PTX h 0 xx
"text" "m" PTY h 0 yy
"CECOLOR" 3
"line" PT PTC "")
(setq PT (list (car PT) (- (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
PTD (list (+ (/ di 2) (car PT)) (+ h (cadr PT)))
PTX (list (+ di (/ di 2) (- 0 h) (car PTD)) (cadr PTD))
PTY (list (+ kc (- h h h h) (car PTX)) (cadr PTX))
k (+ 1 k));setq
);while
(if (= k n)
(setq PT (list (car PT) (+ (cadr PT)(* 2 h)))
PTC (list (+ (* 2 kc) (- di h h h h) (car PT)) (cadr PT))
L11 (list (+ di (car PT))(cadr PT))
L22 (list (+ kc (- 0 h h) (car L11))(cadr L11))
);setq
);if
(command "CECOLOR" 3
"line" p3 PT ""
"line" p4 PTC ""
"line" L1 L11 ""
"line" L2 L22 "")
);progn
);if
(setvar "CECOLOR" lacol)
(setvar "osmode" om)
(prompt"\n\n")
(command "Undo" "End")
(setvar "cmdecho" 1)
(princ)
);DONG toa do


cái lsp trên bạn post của anh Thaistreetz, nếu mún bạn pm riêng cho anh ấy thử xem