Jump to content
InfoFile
Tác giả: ketxu
Bài viết gốc: 212256
Tên lệnh: abc
[yêu cầu] lisp tính ngược giá trị của mắt lưới san nền ?
Un-tested


(defun c:abc(/ e->v ct tm)(vl-load-com)
(setq e->v vlax-ename->vla-object ct (lambda(en)(atof(vla-get-textstring (e->v en))))
tm
((lambda(tl q s n / ss)(- (/ (* n q) s) tl))
(apply '+ (mapcar 'ct (acet-ss-to-list (setq ss (ssget (list (cons 0 "*TEXT")))))))
(ct (car (entsel "\nText khoi luong san nen :")))
(ct (car (entsel "\nText dien tich :")))
(sslength ss)
)
>>
Un-tested


(defun c:abc(/ e->v ct tm)(vl-load-com)
(setq e->v vlax-ename->vla-object ct (lambda(en)(atof(vla-get-textstring (e->v en))))
tm
((lambda(tl q s n / ss)(- (/ (* n q) s) tl))
(apply '+ (mapcar 'ct (acet-ss-to-list (setq ss (ssget (list (cons 0 "*TEXT")))))))
(ct (car (entsel "\nText khoi luong san nen :")))
(ct (car (entsel "\nText dien tich :")))
(sslength ss)
)
)
(vla-put-textstring (e->v (car(entsel "\nText ket qua :"))) tm)
(princ)
)

<<

Filename: 212256_abc.lsp
Tác giả: Skywings
Bài viết gốc: 212307
Tên lệnh: klg1
[yêu cầu] lisp tính ngược giá trị của mắt lưới san nền ?

ui sr, ko đọc kỹ đề bài ^^! Edit ...

(defun GET-TEXT ()
(princ "\nChon cac cao trinh san lap <TEXT>: ")
(while (null (setq Hsl (ssget '((0 . "TEXT")))))
(princ "\n**You selected NOTHING!**")
)
)
(defun c:KLG1 (/ DT ENT HSL ID INDEX RESULT TXT VALUE KL)
(GET-TEXT)
(while (/= Hsl nil)
(while
(or (null
(setq dt (car (entsel "\nDien tich o: ")))
>>
ui sr, ko đọc kỹ đề bài ^^! Edit ...

(defun GET-TEXT ()
(princ "\nChon cac cao trinh san lap <TEXT>: ")
(while (null (setq Hsl (ssget '((0 . "TEXT")))))
(princ "\n**You selected NOTHING!**")
)
)
(defun c:KLG1 (/ DT ENT HSL ID INDEX RESULT TXT VALUE KL)
(GET-TEXT)
(while (/= Hsl nil)
(while
(or (null
(setq dt (car (entsel "\nDien tich o: ")))
)
(/= (cdr (assoc 0 (entget dt))) "TEXT")
(null (numberp (read (cdr (assoc 1 (entget dt))))))
)
(princ "\nDien tich o: ")
)
(while
(or (null
(setq kl (car (entsel "\nKhoi luong: ")))
)
(/= (cdr (assoc 0 (entget kl))) "TEXT")
(null (numberp (read (cdr (assoc 1 (entget kl))))))
)
(princ "\nKhoi luong: ")
)
(setq dt (atof (cdr (assoc 1 (entget dt)))))
(setq kl (atof (cdr (assoc 1 (entget kl)))))
(setq index 0
id 0
result 0
)
(repeat (sslength Hsl)
(setq ent (entget (ssname Hsl index))
value (read (cdr (assoc 1 ent)))
index (1+ index)
)
(if (numberp value)
(setq result (+ result value)
id (1+ id)
)
)
)
(setq result (- (/ (* kl (1+ id)) dt) result))
(while (null (setq txt (entsel "\nChoose TEXT to replace: ")))
(princ "\n**You selected NOTHING!**")
)
(setq txt (entget (car txt))
txt (subst (cons 1 (rtos result 2 2)) (assoc 1 txt) txt)
)
(entmod txt)
(setq Hsl (ssget '((0 . "TEXT"))))
)
(princ)
)

<<

Filename: 212307_klg1.lsp
Tác giả: bach1212
Bài viết gốc: 212401
Tên lệnh: dcd
Nhờ các bác viết dùm Lisp đánh cao độ

Lisp đã wonderul. Đa tạ các cao nhân a hùng đã ra tay giúp đỡ. :P :D
Đây là bản chỉnh sửa lần cuối, bạn nào cần lisp này như mình thì mời xơi ở đây nhé
>>
Lisp đã wonderul. Đa tạ các cao nhân a hùng đã ra tay giúp đỡ. :P :D
Đây là bản chỉnh sửa lần cuối, bạn nào cần lisp này như mình thì mời xơi ở đây nhé :D

;; free lisp from cadviet.com
;;; this lisp was downloaded from
http://www.cadviet.com/forum/index.php?showtopic=12103&st=20
(defun c:dcd(/ blname dmo cdm cd dm cdmi dmoc)
(setvar "attreq" 1)
(setvar "cmdecho" 0)
(setq oldim (getvar "DimZin"))
(setvar "Dimzin" 0)
(or tlv (setq tlv (/ 1 (getreal "\n Nhap ti le ve : 1/"))))
(or bl (setq bl (car(entsel "\n Pick chon Block mau / Text mau :"))))
(or blm (setq blm (entget bl)))
(setq dmo (getpoint "\n Pick diem moc : "))
(setq cdm (getreal "\n Nhap cao do cua diem moc \ Enter pick text cao
do : "))
(if (null cdm) (setq cdm (atof (cdr(assoc 1 (entget(car (entsel "pick
text cao do : "))))))) )
(if cdm (progn
(if (= cdm 0) (setq cd (strcat "%%p" (rtos cdm 2 2))))
(if (> cdm 0) (setq cd (strcat "+" (rtos cdm 2 2))))
(if (< cdm 0) (setq cd (rtos cdm 2 2)))
(setq dmoc dmo)
(while (setq dm (getpoint dmoc "\n Pick diem tiep theo :"))
(if (> (cadr dm) (cadr dmo)) (setq cdmi (+ (* (- (cadr dm) (cadr dmo))
tlv) cdm) ) )
(if (<= (cadr dm) (cadr dmo)) (setq cdmi (- cdm (* (- (cadr dmo) (cadr
dm)) tlv) ) ) )
(if (= cdmi 0) (setq cdi (strcat "%%p" (rtos cdmi 2 2))))
(if (> cdmi 0) (setq cdi (strcat "+" (rtos cdmi 2 2))))
(if (< cdmi 0) (setq cdi (rtos cdmi 2 2)))
(command "copy" bl "" "_non" (cdr(assoc 10 blm)) "_non" dm)
(if (and (wcmatch (cdr(assoc 0 (entget (entlast)))) "INSERT") (=
(cdr(assoc 66 (entget (entlast)))) 1))
(setq el (entget (entnext (entlast)) )))
(if (wcmatch (cdr(assoc 0 (entget (entlast)))) "TEXT") (setq el (entget
(entlast))) )
(entmod (subst (cons 1 cdi) (assoc 1 el) el))
(entupd (entlast))
(setq dmoc dm)
)
(setvar "Dimzin" oldim)
)))
(princ)
)


<<

Filename: 212401_dcd.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 212589
Tên lệnh: ha
đo chiều dài đường cong tại hai điểm bất kỳ


Filename: 212589_ha.lsp
Tác giả: Tue_NV
Bài viết gốc: 212648
Tên lệnh: xyz
[Nhờ sửa list] list thêm dòng text vào dưới Text2

Vậy bạn sử dụng Lisp này xem thử ưng bụng không nhé!

Bạn không thích nhập nữa thì để 1 chuỗi trắng và enter -> Kết thúc là xong

Filename: 212648_xyz.lsp
Tác giả: Tue_NV
Bài viết gốc: 52791
Tên lệnh: lte
Vẽ 1 đường Line(có 2 đoạn) sau đó cho phép người dùng nhập ký tự vào 2 text1, text2

Bạn chưa nói rõ thuộc tính của đường Line và text của bạn (Layer, color)
Đoạn Lisp sau sẽ vẽ 2 đường Line cho bạn sau đó cho phép người dùng nhập ký tự vào 2 text1, text2
Text1 là text trên. Text2 là text dưới.

Hy vọng bạn hài lòng.
Chúc thành công :undecided:

Filename: 52791_lte.lsp
Tác giả: Tue_NV
Bài viết gốc: 213008
Tên lệnh: stre
[yêu cầu] Lisp stretch nhóm đối tượng 2 phía vào giữa và xung quanh vào tâm

TH1 : Làm 2 lần sẽ lâu hơn làm 1 lần. Nhưng lâu hơn chẳng bao nhiêu thời gian
Nếu bạn thích thì code đây:

TH2: Bạn dùng Block Dynamic hoặc dùng lệnh ARRAY của CAD2012 thì chỉ việc pick chọn, kéo và kéo là xong
Nhanh hơn cả khi viết Lisp phải chọn tâm và lọc chọn đối tượng

Filename: 213008_stre.lsp
Tác giả: girl
Bài viết gốc: 212554
Tên lệnh: abc
[yêu cầu] lisp tính ngược giá trị của mắt lưới san nền ?
Em sửa được trong trường hợp có 3 text được chọn thì lisp chạy đúng rồi. Nhưng trong trường hợp 2 text được chọn thì chạy sai, em không hiểu được. hic. Các anh sửa giúp em trường hợp có 2 text được chọn nhé !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=66427&hl=&fromsearch=1
(defun c:abc(/ e->v ct tm)(vl-load-com)
(setq...
>>
Em sửa được trong trường hợp có 3 text được chọn thì lisp chạy đúng rồi. Nhưng trong trường hợp 2 text được chọn thì chạy sai, em không hiểu được. hic. Các anh sửa giúp em trường hợp có 2 text được chọn nhé !

;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.com/forum/index.php?showtopic=66427&hl=&fromsearch=1
(defun c:abc(/ e->v ct tm)(vl-load-com)
(setq e->v vlax-ename->vla-object ct (lambda(en)(atof(vla-get-textstring (e->v en))))
tm
((lambda(tl q s n / ss)(- (/ (* (+ 1 n) q) s) tl))
(apply '+ (mapcar 'ct (acet-ss-to-list (setq ss (ssget (list (cons 0 "*TEXT")))))))
(ct (car (entsel "\nText khoi luong san nen :")))
(ct (car (entsel "\nText dien tich :")))
(sslength ss)
)
)
(vla-put-textstring (e->v (car(entsel "\nText ket qua :"))) tm)
(princ)
)


<<

Filename: 212554_abc.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 213133
Tên lệnh: ha
Nhờ viết lisp ghi đường dẫn file nguồn
Lisp thì đây bạn!

Filename: 213133_ha.lsp
Tác giả: vuminhchau
Bài viết gốc: 213141
Tên lệnh: cc trr nh ch dc1 dcs dcq1 dcq dkt
[Nhờ viết] mã code đường dẫn load lisp

Em trích 1 phần trong đó:
nếu em đặt đoạn code trên lên như vậy thì có đúng không ạ!
vì em muốn là lisp chỉ hiểu khi để đúng đường dẫn đó, còn để trỗ khác thì khi load lisp nó sẽ không hiểu lệnh!

(if(findfile "W:\\MinhChau\\AutoCAD\\Tienich\\Thu Vien\\cadviet.lsp")
(progn
(load "W:\\MinhChau\\AutoCAD\\Tienich\\Thu Vien\\cadviet.lsp"))
(progn (princ...
>>

Em trích 1 phần trong đó:
nếu em đặt đoạn code trên lên như vậy thì có đúng không ạ!
vì em muốn là lisp chỉ hiểu khi để đúng đường dẫn đó, còn để trỗ khác thì khi load lisp nó sẽ không hiểu lệnh!

(if(findfile "W:\\MinhChau\\AutoCAD\\Tienich\\Thu Vien\\cadviet.lsp")
(progn
(load "W:\\MinhChau\\AutoCAD\\Tienich\\Thu Vien\\cadviet.lsp"))
(progn (princ "\nKhong ton tai file")
(princ))
)
========================================
(defun c:CC (/ SO CHON SL I KQ TEN CS A); chuong trinh cong cac so roi gan text ra man hinh
(princ "\n ")
(princ "chon lan luot cac so can CONG")
(setq CHON (ssget))
(setq SL (sslength CHON))
(setq I 0)
(setq KQ 0)
(while (< I SL)
(progn
(setq TEN (ssname CHON I))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ (+ KQ SO))
(setq i (+ i 1))
) ; end progn
) ; end while
(SETQ A (GETPOINT "Chon diem dat ket qua : "))
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos KQ 2 2))
(princ)
) ; end defun
(defun c:TRR (/ SO CHON SL I KQ TEN CS A)
; chuong trinh tru cac so roi gan text ra man hinh
(princ "\n ")
(princ "chon lan luot cac so can TRU")
(setq CHON (ssget))
(setq SL (sslength CHON))
(setq TEN (ssname CHON 0))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ SO)
(setq i 1)
(while (< i SL)
(progn
(setq TEN (ssname CHON i))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS)))))
(setq KQ (- KQ SO))
(setq i (+ i 1))
) ; end progn
) ; end while
(SETQ A (GETPOINT "Chon diem dat ket qua : "))
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos KQ 2 2))
(princ)
) ; end defun
(defun c:NH (/ SO CHON SL I KQ TEN CS A); chuong trinh nhan cac so roi gan text ra man hinh
(princ "\n ")
(princ "chon lan luot cac so can NHAN")
(setq CHON (ssget))
(setq SL (sslength CHON))
(setq I 0)
(setq KQ 1)
(while (< I SL)
(progn
(setq TEN (ssname CHON I))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ (* KQ SO))
(setq i (+ i 1))
) ; end progn
) ; end while
(SETQ A (GETPOINT "Chon diem dat ket qua : "))
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos KQ 2 2))
(princ)
) ; end defun
(defun c:CH (/ SO CHON SL I KQ TEN CS A); chuong trinh CHIA cac so roi gan text ra man hinh
(princ "\n ")
(princ "chon lan luot cac so can CHIA")
(setq CHON (ssget))
(setq SL (sslength CHON))
(setq TEN (ssname CHON 0))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ SO)
(setq i 1)
(while (< i SL)
(progn
(setq TEN (ssname CHON i))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ (/ KQ SO))
(setq i (+ i 1))
) ; end progn
) ; end while
(SETQ A (GETPOINT "Chon diem dat ket qua : "))
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos KQ 2 2))
(princ)
) ; end defun

(DEFUN C:DC1 (/ A B DTD CHON DT KC) ; DIEU CHINH 1 CANH SONG SONG DE CO DIEN TICH THEO Y MUON
(PRINC "\n")
(SETQ A (GETPOINT
"\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH :|CLICK| "
)
)
(SETQ DTD (getreal "\n NHAP DIEN TICH CAN DIEU CHINH : "))
(princ "\n CHON DUONG THANG CAN DI CHUYEN")
(SETQ CHON (ssget))
(SETQ B (GETPOINT "\n CHON HUONG CAN DI CHUYEN "))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
(SETQ KC "1")
(if (< DT DTD)
(progn
(while (< DT DTD)
(progn
(command ".offset" KC CHON B "")
(COMMAND "ERASE" CHON "")
(SETQ CHON (ssget "L"))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
(progn
(while (> DT DTD)
(progn
(command ".offset" KC CHON B "")
(COMMAND "ERASE" CHON "")
(SETQ CHON (ssget "L"))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
) ; end if
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos (GETVAR "AREA") 2 2))
(PRINC)
) ; end defun

(DEFUN C:DCS (/ A B DTD CHON DT KC) ; DIEU CHINH 1 CANH SONG SONG DE CO DIEN TICH THEO Y MUON
(PRINC "\n")
(SETQ A (GETPOINT
"\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH : |CLICK|"
)
)
(SETQ DTD (getreal "\n NHAP DIEN TICH CAN DIEU CHINH : "))
(princ "\n CHON DUONG THANG CAN DI CHUYEN")
(SETQ CHON (ssget))
(SETQ B (GETPOINT "\n CHON HUONG CAN DI CHUYEN "))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
(SETQ KC "0.001")
(if (< DT DTD)
(progn
(while (< DT DTD)
(progn
(command ".offset" KC CHON B "")
(COMMAND "ERASE" CHON "")
(SETQ CHON (ssget "L"))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
(progn
(while (> DT DTD)
(progn
(command ".offset" KC CHON B "")
(COMMAND "ERASE" CHON "")
(SETQ CHON (ssget "L"))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
) ; end if
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos (GETVAR "AREA") 2 2))
(PRINC)
) ; end defun
(DEFUN C:DCQ1 (/ A DTD CHON B C HUONG H DT)
; DIEU CHINH 1 CANH QUAY QUANH MOT DIEM DE CO DIEN TICH THEO Y MUON
(PRINC "\n")
(SETQ A (GETPOINT
"\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH :|CLICK| "
)
)
(SETQ DTD (getreal "\n NHAP DIEN TICH CAN DIEU CHINH : "))
(princ "\n CHON DUONG THANG CAN QUAY")
(SETQ CHON (ssget))
(SETQ C (GETPOINT "\n CHON TAM QUAY "))
(SETQ HUONG
(GETSTRING
"\n CHON HUONG CAN QUAY: |CUNG CHIEU KIM (-)|; |NGUOC CHIEU (+)| "
)
)
(IF (= HUONG "+")
(SETQ H "+1")
(SETQ H "-1")
) ; end if
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
(IF (< DT DTD)
(progn
(while (< DT DTD)
(progn
(command ".rotate" CHON "" C H "")
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
(progn
(while (> DT DTD)
(progn
(command ".rotate" CHON "" C H "")
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
) ; end if
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos (GETVAR "AREA") 2 2))
(PRINC)
) ; end defun

(DEFUN C:DCQ (/ A DTD CHON B C HUONG H DT)
; DIEU CHINH 1 CANH QUAY QUANH MOT DIEM DE CO DIEN TICH THEO Y MUON
(PRINC "\n")
(SETQ A (GETPOINT
"\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH :|CLICK| "
)
)
(SETQ DTD (getreal "\n NHAP DIEN TICH CAN DIEU CHINH : "))
(princ "\n CHON DUONG THANG CAN QUAY")
(SETQ CHON (ssget))
(SETQ C (GETPOINT "\n CHON TAM QUAY "))
(SETQ HUONG
(GETSTRING
"\n CHON HUONG CAN QUAY: |CUNG CHIEU KIM (-)|; |NGUOC CHIEU (+)| "
)
)
(IF (= HUONG "+")
(SETQ H "+0.001")
(SETQ H "-0.001")
) ; end if
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
(IF (< DT DTD)
(progn
(while (< DT DTD)
(progn
(command ".rotate" CHON "" C H "")
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
(progn
(while (> DT DTD)
(progn
(command ".rotate" CHON "" C H "")
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
) ; end if
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos (GETVAR "AREA") 2 2))
(PRINC)
) ; end defun
(defun C:DKT (/)
(PRINC "\n")
;;; (SETQ DT (SSGET))
;;; (setq Thoi 0)
;;; (while (= Thoi 0)
;;; (if (/= (setq DT
;;; (SSGET
;;; "\n CHON DOI TUONG TIEP THEO? NEU KHONG THI !!!"
;;; )
;;; )
;;; nil
;;; )
;;; (progn
;;; (command ".DIMALIGNED" "" "" DT "")
;;; )
;;; (setq Thoi 1)
;;; ) ; end if
;;; ) ; end while
;;; (SETQ A (GETPOINT
;;; "\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH :|CLICK| "
;;; )
;;; )
;;; (PRINC "\N DIEM A")
;;; (PRINC A)
;;; (setq P1 (STRCAT (RTOS (car A)) "," (RTOS (cadr A))))
;;; (PRINC "\N DIEM P1")
;;; (PRINC P1)
;;; (setq P2 (list (+ (car A) 14) (- (cadr A) 14)))
(SETQ CHON (SSGET))
(PRINC CHON)
(SETQ LEN (sslength CHON))
(PRINC "\N ")
(PRINC LEN)
(SETQ I 0)
(WHILE (<= I LEN)
(PROGN
(SETQ TEN (ssname CHON I))
(SETQ DT (entget TEN))
(PRINC DT)
(command ".DIMALIGNED" "" "" DT "" "")
(SETQ I (+ I 1))
); END PROGN
); END WHILE
); end defun
;;; (alert
;;; " - - - - http://www.cadviet.com - - - -
;;;------------------------------------------------
;;;| Ghi chu | Ten lenh |
;;;------------------------------------------------
;;;Chen HSKT cap GCN font Unicode CG
;;;Chen HSKT cap GCN font VNI CGV
;;;Chen HSKT tach dat font Unicode TD
;;;Chen HSKT tach dat font VNI TDV
;;;Chen HSKT tach dat co nha font Unicode TN
;;;Chen HSKT tach dat co nha font VNI TNV
;;;Tao hatch cho ranh nha H250
;;;Tao hatch cho thua dat HD
;;;Cat nhung doan giao nhau BL
;;;Tinh dien tich DT
;;;Code kich thuoc ca doan KT
;;;Code kich thuoc giua 2 diem KTT
;;;Tinh dien tich 1/200 t2
;;;Tinh nhieu dien tich 1/200 tt2
;;;Tinh dien tich 1/250 t25
;;;Tinh nhieu dien tich 1/250 tt25
;;;Tinh dien tich 1/500 t5
;;;Tinh nhieu dien tich 1/500 tt5
;;;Tao hatch cho ranh nha h1000
;;;Tao hatch cho dat tam giao ht
;;;Tao net ranh dat mrd
;;;Tao net lo gioi mlg
;;;Tao net mep duong mmd
;;;Tao net tim duong mtd
;;;Hi&#211;n th&#222; &#174;&#233; cao c&#241;a &#174;&#173;&#234;ng &#174;&#229;ng m&#248;c cd
;;;N&#190;n d&#173;&#234;ng b&#215;nh &#174;&#233; ss
;;;Ch&#204;n &#174;&#233; cao cho di&#211;m mia &#174;&#222;a h&#215;nh nn
;;;S&#246;a &#174;&#233; cao cho &#174;i&#211;m mia &#174;&#222;a h&#215;nh sdc
;;;&#167;&#173;a TEXT C&#241;A CAO &#167;&#233; l&#170;n 3D 3d
;;;" )

<<

Filename: 213141_cc_trr_nh_ch_dc1_dcs_dcq1_dcq_dkt.lsp
Tác giả: tien2005
Bài viết gốc: 213187
Tên lệnh: ha
Nhờ viết lisp ghi đường dẫn file nguồn
Mình mạn phép lấy lisp của @Doan Van Ha sửa lại cho Bạn

(defun C:HA( / lst)
(load "julian.lsp")
(setq lst (jtoc (getvar "date")))
(setq a (strcat (getvar "SAVENAME") "-//" (itoa (nth 2 lst)) "-" (itoa (nth 1 lst)) "-" (itoa (nth 0 lst)) "//" (itoa (nth 3 lst)) ":" (itoa (nth 4 lst))))
(ENTMAKE (LIST(CONS 0 "TEXT")(CONS 1 A)(CONS 40 300)(CONS 10...
>>
Mình mạn phép lấy lisp của @Doan Van Ha sửa lại cho Bạn

(defun C:HA( / lst)
(load "julian.lsp")
(setq lst (jtoc (getvar "date")))
(setq a (strcat (getvar "SAVENAME") "-//" (itoa (nth 2 lst)) "-" (itoa (nth 1 lst)) "-" (itoa (nth 0 lst)) "//" (itoa (nth 3 lst)) ":" (itoa (nth 4 lst))))
(ENTMAKE (LIST(CONS 0 "TEXT")(CONS 1 A)(CONS 40 300)(CONS 10 (GETPOINT"\nINSERT POINT"))))
)


lưu ý: (CONS 40 300) trong đó 300 là chiều cao text
<<

Filename: 213187_ha.lsp
Tác giả: quansla
Bài viết gốc: 213147
Tên lệnh: cc trr nh ch dc1 dcs dcq1 dcq dkt
[Nhờ viết] mã code đường dẫn load lisp

Không hiểu chủ pic hiểu ý anh Hà chưa, chủ pic mắc lỗi như thế này: đoạn code mình đưa cho bạn là dùng để làm chương trình con hoặc tự chạy để kiểm tra sự tồn tại của file ấn định sẵn tức (cadviet.lsp trong đường dẫn cố định cho sẵn) nếu có thì load lisp A,B,C nào đó(trong TH này là đồng thời là Cadviet.lsp luôn) nghĩa là toàn bộ phần "hồn" của lisp ( tức là "công...
>>

Không hiểu chủ pic hiểu ý anh Hà chưa, chủ pic mắc lỗi như thế này: đoạn code mình đưa cho bạn là dùng để làm chương trình con hoặc tự chạy để kiểm tra sự tồn tại của file ấn định sẵn tức (cadviet.lsp trong đường dẫn cố định cho sẵn) nếu có thì load lisp A,B,C nào đó(trong TH này là đồng thời là Cadviet.lsp luôn) nghĩa là toàn bộ phần "hồn" của lisp ( tức là "công sức " người viết các code lisp đó) phải được đặt trong file Cadviet.lsp này. Nghĩa là kiểm tra có file Cadviet.lsp thì load data trong file
Còn bạn load luôn một file chứa nhiều Code lisp thì Cad load cả luôn chứ còn gì nữa, code đầu tiên thì bỏ qua vì nil, còn các code sau có ảnh hưởng gì đâu
Mình dần thấy bạn không nên cố kiểu "đánh dấu bản quyền" này làm gì nữa. Làm mem Cadviet tinh thần chia sẻ thì hẹp hòi làm gì vài Code kia,
Bài toán của bạn nói chung là giải như thế này
file dưới đây thì đưa nhân viên

(if(findfile "W:\\MinhChau\\AutoCAD\\Tienich\\Thu Vien\\ChayKybo.lsp")
(progn
(load "W:\\MinhChau\\AutoCAD\\Tienich\\Thu Vien\\ChauKybo.lsp"))
(progn (princ "\nKhong ton tai file")
(princ))
)

file dưới này thì đặt tên là ChauKybo.lsp bỏ vô thư mục W:\MinhChau\AutoCAD\Tienich\Thuvie\ChauKybo.lsp

========================================
(defun c:CC (/ SO CHON SL I KQ TEN CS A); chuong trinh cong cac so roi gan text ra man hinh
(princ "\n ")
(princ "chon lan luot cac so can CONG")
(setq CHON (ssget))
(setq SL (sslength CHON))
(setq I 0)
(setq KQ 0)
(while (< I SL)
(progn
(setq TEN (ssname CHON I))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ (+ KQ SO))
(setq i (+ i 1))
) ; end progn
) ; end while
(SETQ A (GETPOINT "Chon diem dat ket qua : "))
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos KQ 2 2))
(princ)
) ; end defun
(defun c:TRR (/ SO CHON SL I KQ TEN CS A)
; chuong trinh tru cac so roi gan text ra man hinh
(princ "\n ")
(princ "chon lan luot cac so can TRU")
(setq CHON (ssget))
(setq SL (sslength CHON))
(setq TEN (ssname CHON 0))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ SO)
(setq i 1)
(while (< i SL)
(progn
(setq TEN (ssname CHON i))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS)))))
(setq KQ (- KQ SO))
(setq i (+ i 1))
) ; end progn
) ; end while
(SETQ A (GETPOINT "Chon diem dat ket qua : "))
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos KQ 2 2))
(princ)
) ; end defun
(defun c:NH (/ SO CHON SL I KQ TEN CS A); chuong trinh nhan cac so roi gan text ra man hinh
(princ "\n ")
(princ "chon lan luot cac so can NHAN")
(setq CHON (ssget))
(setq SL (sslength CHON))
(setq I 0)
(setq KQ 1)
(while (< I SL)
(progn
(setq TEN (ssname CHON I))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ (* KQ SO))
(setq i (+ i 1))
) ; end progn
) ; end while
(SETQ A (GETPOINT "Chon diem dat ket qua : "))
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos KQ 2 2))
(princ)
) ; end defun
(defun c:CH (/ SO CHON SL I KQ TEN CS A); chuong trinh CHIA cac so roi gan text ra man hinh
(princ "\n ")
(princ "chon lan luot cac so can CHIA")
(setq CHON (ssget))
(setq SL (sslength CHON))
(setq TEN (ssname CHON 0))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ SO)
(setq i 1)
(while (< i SL)
(progn
(setq TEN (ssname CHON i))
(setq CS (entget TEN))
(setq SO (atof (cdr (assoc 1 CS))))
(setq KQ (/ KQ SO))
(setq i (+ i 1))
) ; end progn
) ; end while
(SETQ A (GETPOINT "Chon diem dat ket qua : "))
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos KQ 2 2))
(princ)
) ; end defun
(DEFUN C:DC1 (/ A B DTD CHON DT KC) ; DIEU CHINH 1 CANH SONG SONG DE CO DIEN TICH THEO Y MUON
(PRINC "\n")
(SETQ A (GETPOINT
"\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH :|CLICK| "
)
)
(SETQ DTD (getreal "\n NHAP DIEN TICH CAN DIEU CHINH : "))
(princ "\n CHON DUONG THANG CAN DI CHUYEN")
(SETQ CHON (ssget))
(SETQ B (GETPOINT "\n CHON HUONG CAN DI CHUYEN "))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
(SETQ KC "1")
(if (< DT DTD)
(progn
(while (< DT DTD)
(progn
(command ".offset" KC CHON B "")
(COMMAND "ERASE" CHON "")
(SETQ CHON (ssget "L"))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
(progn
(while (> DT DTD)
(progn
(command ".offset" KC CHON B "")
(COMMAND "ERASE" CHON "")
(SETQ CHON (ssget "L"))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
) ; end if
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos (GETVAR "AREA") 2 2))
(PRINC)
) ; end defun
(DEFUN C:DCS (/ A B DTD CHON DT KC) ; DIEU CHINH 1 CANH SONG SONG DE CO DIEN TICH THEO Y MUON
(PRINC "\n")
(SETQ A (GETPOINT
"\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH : |CLICK|"
)
)
(SETQ DTD (getreal "\n NHAP DIEN TICH CAN DIEU CHINH : "))
(princ "\n CHON DUONG THANG CAN DI CHUYEN")
(SETQ CHON (ssget))
(SETQ B (GETPOINT "\n CHON HUONG CAN DI CHUYEN "))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
(SETQ KC "0.001")
(if (< DT DTD)
(progn
(while (< DT DTD)
(progn
(command ".offset" KC CHON B "")
(COMMAND "ERASE" CHON "")
(SETQ CHON (ssget "L"))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
(progn
(while (> DT DTD)
(progn
(command ".offset" KC CHON B "")
(COMMAND "ERASE" CHON "")
(SETQ CHON (ssget "L"))
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
) ; end if
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos (GETVAR "AREA") 2 2))
(PRINC)
) ; end defun
(DEFUN C:DCQ1 (/ A DTD CHON B C HUONG H DT)
; DIEU CHINH 1 CANH QUAY QUANH MOT DIEM DE CO DIEN TICH THEO Y MUON
(PRINC "\n")
(SETQ A (GETPOINT
"\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH :|CLICK| "
)
)
(SETQ DTD (getreal "\n NHAP DIEN TICH CAN DIEU CHINH : "))
(princ "\n CHON DUONG THANG CAN QUAY")
(SETQ CHON (ssget))
(SETQ C (GETPOINT "\n CHON TAM QUAY "))
(SETQ HUONG
(GETSTRING
"\n CHON HUONG CAN QUAY: |CUNG CHIEU KIM (-)|; |NGUOC CHIEU (+)| "
)
)
(IF (= HUONG "+")
(SETQ H "+1")
(SETQ H "-1")
) ; end if
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
(IF (< DT DTD)
(progn
(while (< DT DTD)
(progn
(command ".rotate" CHON "" C H "")
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
(progn
(while (> DT DTD)
(progn
(command ".rotate" CHON "" C H "")
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
) ; end if
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos (GETVAR "AREA") 2 2))
(PRINC)
) ; end defun
(DEFUN C:DCQ (/ A DTD CHON B C HUONG H DT)
; DIEU CHINH 1 CANH QUAY QUANH MOT DIEM DE CO DIEN TICH THEO Y MUON
(PRINC "\n")
(SETQ A (GETPOINT
"\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH :|CLICK| "
)
)
(SETQ DTD (getreal "\n NHAP DIEN TICH CAN DIEU CHINH : "))
(princ "\n CHON DUONG THANG CAN QUAY")
(SETQ CHON (ssget))
(SETQ C (GETPOINT "\n CHON TAM QUAY "))
(SETQ HUONG
(GETSTRING
"\n CHON HUONG CAN QUAY: |CUNG CHIEU KIM (-)|; |NGUOC CHIEU (+)| "
)
)
(IF (= HUONG "+")
(SETQ H "+0.001")
(SETQ H "-0.001")
) ; end if
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
(IF (< DT DTD)
(progn
(while (< DT DTD)
(progn
(command ".rotate" CHON "" C H "")
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
(progn
(while (> DT DTD)
(progn
(command ".rotate" CHON "" C H "")
(COMMAND "BOUNDARY" A "")
(COMMAND "AREA" "O" (SSGET "L"))
(COMMAND "ERASE" (SSGET "L") "")
(SETQ DT (GETVAR "AREA"))
) ; end progn
) ; end while
) ; end progn
) ; end if
(command "-STYLE" "0" "VNI-AVO" "1" "1" "0" "N" "N" "N")
(command ".text" "J" "BL" A "0" (rtos (GETVAR "AREA") 2 2))
(PRINC)
) ; end defun
(defun C:DKT (/)
(PRINC "\n")
;;; (SETQ DT (SSGET))
;;; (setq Thoi 0)
;;; (while (= Thoi 0)
;;; (if (/= (setq DT
;;; (SSGET
;;; "\n CHON DOI TUONG TIEP THEO? NEU KHONG THI !!!"
;;; )
;;; )
;;; nil
;;; )
;;; (progn
;;; (command ".DIMALIGNED" "" "" DT "")
;;; )
;;; (setq Thoi 1)
;;; ) ; end if
;;; ) ; end while
;;; (SETQ A (GETPOINT
;;; "\n CHON GIUA DOI TUONG CAN DIEU CHINH DIEN TICH :|CLICK| "
;;; )
;;; )
;;; (PRINC "\N DIEM A")
;;; (PRINC A)
;;; (setq P1 (STRCAT (RTOS (car A)) "," (RTOS (cadr A))))
;;; (PRINC "\N DIEM P1")
;;; (PRINC P1)
;;; (setq P2 (list (+ (car A) 14) (- (cadr A) 14)))
(SETQ CHON (SSGET))
(PRINC CHON)
(SETQ LEN (sslength CHON))
(PRINC "\N ")
(PRINC LEN)
(SETQ I 0)
(WHILE (<= I LEN)
(PROGN
(SETQ TEN (ssname CHON I))
(SETQ DT (entget TEN))
(PRINC DT)
(command ".DIMALIGNED" "" "" DT "" "")
(SETQ I (+ I 1))
); END PROGN
); END WHILE
); end defun
;;; (alert
;;; " - - - - http://www.cadviet.com - - - -
;;;------------------------------------------------
;;;| Ghi chu | Ten lenh |
;;;------------------------------------------------
;;;Chen HSKT cap GCN font Unicode CG
;;;Chen HSKT cap GCN font VNI CGV
;;;Chen HSKT tach dat font Unicode TD
;;;Chen HSKT tach dat font VNI TDV
;;;Chen HSKT tach dat co nha font Unicode TN
;;;Chen HSKT tach dat co nha font VNI TNV
;;;Tao hatch cho ranh nha H250
;;;Tao hatch cho thua dat HD
;;;Cat nhung doan giao nhau BL
;;;Tinh dien tich DT
;;;Code kich thuoc ca doan KT
;;;Code kich thuoc giua 2 diem KTT
;;;Tinh dien tich 1/200 t2
;;;Tinh nhieu dien tich 1/200 tt2
;;;Tinh dien tich 1/250 t25
;;;Tinh nhieu dien tich 1/250 tt25
;;;Tinh dien tich 1/500 t5
;;;Tinh nhieu dien tich 1/500 tt5
;;;Tao hatch cho ranh nha h1000
;;;Tao hatch cho dat tam giao ht
;;;Tao net ranh dat mrd
;;;Tao net lo gioi mlg
;;;Tao net mep duong mmd
;;;Tao net tim duong mtd
;;;Hi&#211;n th&#222; &#174;&#233; cao c&#241;a &#174;&#173;&#234;ng &#174;&#229;ng m&#248;c cd
;;;N&#190;n d&#173;&#234;ng b&#215;nh &#174;&#233; ss
;;;Ch&#204;n &#174;&#233; cao cho di&#211;m mia &#174;&#222;a h&#215;nh nn
;;;S&#246;a &#174;&#233; cao cho &#174;i&#211;m mia &#174;&#222;a h&#215;nh sdc
;;;&#167;&#173;a TEXT C&#241;A CAO &#167;&#233; l&#170;n 3D 3d
;;;" )

<<

Filename: 213147_cc_trr_nh_ch_dc1_dcs_dcq1_dcq_dkt.lsp
Tác giả: ketxu
Bài viết gốc: 213195
Tên lệnh: ha
Nhờ viết lisp ghi đường dẫn file nguồn
Load Julian code sẽ lâu hơn Diesel code

(defun C:HA( /)
(entmake
(list (cons 0 "TEXT")
(cons 1 (strcat (getvar "dwgprefix") (getvar "dwgname") "-/"
(menucmd "M=$(edtime, $(getvar, date),MO/DD/YY HH:MM AM/PM)")))
(cons 40 300)(cons 10 (getpoint "\nINSERT POINT")))))

Filename: 213195_ha.lsp
Tác giả: ketxu
Bài viết gốc: 213398
Tên lệnh: d50
[Yêu Cầu] lisp dim với layer và dimstyle mặc định
Bạn tạo được dimstyle tên 1:50 bằng cách nào ?
Ví dụ mẫu cho bạn đây, mình đã ghi chú để bạn tự ý thêm, sửa những chỗ tong "" cho ưng
Bài toán này có thể làm bằng Reactor cho unknown command nhưng sẽ gây rắc rối cho bạn


(defun c:d50(/ ov)
(setq ov (getvar 'clayer))
(setvar 'clayer "d50") ;d50 = ten layer trong ban ve
(command "-dimstyle"...
>>
Bạn tạo được dimstyle tên 1:50 bằng cách nào ?
Ví dụ mẫu cho bạn đây, mình đã ghi chú để bạn tự ý thêm, sửa những chỗ tong "" cho ưng
Bài toán này có thể làm bằng Reactor cho unknown command nhưng sẽ gây rắc rối cho bạn


(defun c:d50(/ ov)
(setq ov (getvar 'clayer))
(setvar 'clayer "d50") ;d50 = ten layer trong ban ve
(command "-dimstyle" "restore" "D50") ;D50 = Dimstyle trong ban ve
(command "dimlinear") ;Dimlinear = lenh can thuc hien
(setvar 'clayer ov)
)

<<

Filename: 213398_d50.lsp
Tác giả: ro88
Bài viết gốc: 213464
Tên lệnh: td1
Tác giả: ro88
Bài viết gốc: 213472
Tên lệnh: td1

Filename: 213472_td1.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 213546
Tên lệnh: cbinil cbirnil
2IUnHG yijumvcpcugi, [url=http://zismctfodjjc.com/]zismctfodjjc[/url], [link=http://miaqbkbxfshl.com/]miaqbkbxfshl[/link], http://kazxezxxrdka.com/

Filename: 213546_cbinil_cbirnil.lsp
Tác giả: avi612
Bài viết gốc: 213645
Tên lệnh: ttt
We"re at university together mirapex 1 mg Ever heard of the SMS 7726 shortcode? Ask that question of the average UK mobile phone customer and the overwhelming majority will stare at you blankly
Chà! cũng khó đây...Tại mình chưa thạo lắm về thể loại "lisp vla..." này nên vận dụng cũng chưa tốt lắm.
Dưới đây là đoạn lisp mình đã thử làm..nhưng sai cấu trúc...pác xem lại giùm e nó sai ở đâu với...

Àh! cho mình hỏi thêm luôn là ngoài dùng những hàm lisp "vla.." này thì mình còn có thể làm cách khác được không, ví như những hàm đơn giãn hơn..
>>
Chà! cũng khó đây...Tại mình chưa thạo lắm về thể loại "lisp vla..." này nên vận dụng cũng chưa tốt lắm.
Dưới đây là đoạn lisp mình đã thử làm..nhưng sai cấu trúc...pác xem lại giùm e nó sai ở đâu với...

Àh! cho mình hỏi thêm luôn là ngoài dùng những hàm lisp "vla.." này thì mình còn có thể làm cách khác được không, ví như những hàm đơn giãn hơn..


(defun c:ttt(/ #sset #Bacc i #tong #tong1 #ssname #ename #dau #cuoi #ent #dis #point)
(vl-load-com)
(setvar "CMDECHO" 0)
(command ".undo" "BE")
(command ".UCS" "W" ^C^C)
(Prompt "\n- Ch\U+1ECDn \U+0111o\U+1EA1n th\U+1EB3ng c\U+1EA7n t&#237;nh t\U+1ED5ng: ")
(setq #sset (ssget ":N" '((0 . "*LINE,PLINE,ARC,ELLIPSE"))))
(setq #Bacc (getint "\n- Nh\U+1EADp s\U+1ED1 l\U+1EBB: "))
(if (null #Bacc) (setq #Bacc 2))
(setq i 0)
(setq #tong 0)
(while
(setq #ssname (ssname #sset i))
(setq #ename (cdr (assoc 0 (entget #ssname))))
(setq #dis (vlax-curve-getDistAtParam #ename (vlax-curve-getEndParam #ename)))
(setq #tong (+ #tong #dis))
(setq i (1+ i))
);WHILE
(setq #tong1 (rtos #tong 2 #Bacc))
(setq #point (getpoint "\n- Ch\U+1ECDn \U+0111i\U+1EC3m ch&#232;n k\U+1EBFt qu\U+1EA3: "))
(command ".text" "J" "MC" #point 1.7 0 #tong1)
(command ".undo" "E")
(princ)
(princ)
)

<<

Filename: 213645_ttt.lsp
Tác giả: Tue_NV
Bài viết gốc: 213684
Tên lệnh: cs
[Yêu Cầu] Thay thế text hàng loạt

Lisp này mình đã viết từ lâu rồi.
Link : http://www.cadviet.com/forum/index.php?showtopic=13203&st=700
Sửa theo ý bạn đây :

Filename: 213684_cs.lsp
Tác giả: VoHoan
Bài viết gốc: 213703
Tên lệnh: hskt
[ Nhờ chỉnh sửa] Lisp xuất tọa độ

Mình chỉ sửa theo các ý của "ro88" và "hoangkimioanh" thôi, lisp chạy ra chắc chưa được đẹp lắm. Đế hoàn thiện hơn 2 ban nên nhờ trực tiếp bác "ketxu" nhé. Đây là lisp đã sửa:

;; 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...
>>

Mình chỉ sửa theo các ý của "ro88" và "hoangkimioanh" thôi, lisp chạy ra chắc chưa được đẹp lắm. Đế hoàn thiện hơn 2 ban nên nhờ trực tiếp bác "ketxu" nhé. Đây là lisp đã sửa:

;; 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:HSKT (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
(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 = 1): " )
)

;(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 p02 "")
(linepy p0 (- (distance p0 p02)))
(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))
"")
(setq Lkqua nil)
(wtxtMC "Bang toa do cac dinh thua dat"
(polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
(* 1.2 h) nil)
(txt1 (setq Lkq (list "TT" "X (m)" "Y (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 p0 (polar p0 (* 1.5 pi) (* 2 h)))
(setq pt pv)
(setq j (1+ j))
(if (= j (- n 1)) (setq j 0))
)
;;;MAKE BLOCK
(setq ss (collect1 et))
(setq bn "1")
(while (tblsearch "block" bn)
(setq bn (itoa (1+ (atoi bn))))
)
(command "block" bn p00 ss "")
(command "insert" bn p00 "" "" "")
;;;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 "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)
(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)
)
(command "DIMALIGNED" p1 p2 mp)
(setq i (1+ i))
)
;; repeat k;
)
;;;--------------------------

<<

Filename: 213703_hskt.lsp

Trang 105/330

105