Jump to content
InfoFile
Tác giả: elleHCSC
Bài viết gốc: 129917
Tên lệnh: ctn
Nhờ viết Lisp Match bề dày cho Line


1. Cái lệnh MA này thì mình biết chứ nhưng làm theo yêu cầu đầu bài của bạn almodeus thôi, tức là chỉ MA width của PLINE thôi chứ ko MA để thay đổi cho các thuộc tính khác của 2obj như: Layer, Color... Các bạn dùng 2 cái lisp trên sẽ thấy nó khác biệt nhau về mục đích đó. Theo yêu cầu của đầu bài này thì không nên dùng (command "MATCHPROP" obj (setq ss (ssget '((0 ....
>>


1. Cái lệnh MA này thì mình biết chứ nhưng làm theo yêu cầu đầu bài của bạn almodeus thôi, tức là chỉ MA width của PLINE thôi chứ ko MA để thay đổi cho các thuộc tính khác của 2obj như: Layer, Color... Các bạn dùng 2 cái lisp trên sẽ thấy nó khác biệt nhau về mục đích đó. Theo yêu cầu của đầu bài này thì không nên dùng (command "MATCHPROP" obj (setq ss (ssget '((0 . "*LINE,ARC")))) "") mà chỉ cần đoạn chọn 1 loạt đối tượng đích thông qua (setq ss (ssget)) là đủ.
2. *LINE ??? mà SPLINE hình như cũng không có thuộc tính width đâu.
3. Nếu đưa thêm cả ARC vào thì lệnh PEDIT vô tình cũng chuyển ARC này thành 1 PLINE khá đặc biệt đó, bạn thử kiểm nghiệm lại xem.


<<

Filename: 129917_ctn.lsp
Tác giả: Tue_NV
Bài viết gốc: 90721
Tên lệnh: vpg
Viết lisp theo yêu cầu [phần 2]
Chào em svba.
Gửi em Lisp vẽ đường phân giác

Filename: 90721_vpg.lsp
Tác giả: q288
Bài viết gốc: 59853
Tên lệnh: bl
làm hiện một layer bất kì mà không cần chọn đối tượng


Bạn thử dùng ct này xem, nó cũng chỉ là dùng lệnh layer bình thg thôi.
Nhập tên layer muốn hiện, nếu muốn hiện toàn bộ thì enter . Ten lenh la BL.


Filename: 59853_bl.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 172950
Tên lệnh: ha
nhờ viết lisp vẽ LINE và break đối tượng


Có phải ý bạn muốn như thế này không?

Filename: 172950_ha.lsp
Tác giả: ssg
Bài viết gốc: 47468
Tên lệnh: vd
CadViet’s AutoLisp Public Functions Library

KẾ THỪA VÀ TÍCH LUỸ TÀI NGUYÊN TRONG LẬP TRÌNH LISP
Tôi có thể nhìn xa hơn người khác, vì tôi đang đứng trên vai những người khổng lồ - Isaac Newton


A- DẪN NHẬP

Bạn đã từng lập trình, đã từng biết đến cái cảm giác “khoái chí không thể diễn tả được” khi chạy thử chương trình. Mọi việc đều diễn ra tốt đẹp, mọi cái đều răm rắp hoạt động y như...
>>
KẾ THỪA VÀ TÍCH LUỸ TÀI NGUYÊN TRONG LẬP TRÌNH LISP
Tôi có thể nhìn xa hơn người khác, vì tôi đang đứng trên vai những người khổng lồ - Isaac Newton


A- DẪN NHẬP

Bạn đã từng lập trình, đã từng biết đến cái cảm giác “khoái chí không thể diễn tả được” khi chạy thử chương trình. Mọi việc đều diễn ra tốt đẹp, mọi cái đều răm rắp hoạt động y như ý đồ bạn đã vạch ra. Bạn hứng chí muốn làm thêm vài cái như vậy nữa, vừa thoả mãn sự yêu thích, đam mê của bản thân, vừa có được những công cụ mạnh mẽ để làm việc hiệu quả hơn. Thật tuyệt vời!
Nhưng có bao giờ bạn cảm thấy ngán ngẩm vì những dòng code dài lê thê, với những dấu ngoặc xếp hàng hàng lớp lớp, đan xen, chồng chéo lên nhau (cái “món Lisp” này sao mà lắm dấu ngoặc thế không biết!)? Liệu có cách gì để công việc lập trình dễ dàng hơn, đỡ vất vả hơn mà vẫn đạt được hiệu quả cao hay không?
Câu trả lời là có, và đơn giản đến mức hiển nhiên: SỰ KẾ THỪA

Mọi chương trình Lisp, dù phức tạp đến đâu, cũng đều được xây dựng từ những viên gạch cực kỳ đơn giản:

(Function Arguments)

Hãy học cách tạo, cóp nhặt, sưu tầm, tích luỹ những viên gạch ấy, công việc lập trình của bạn sẽ đơn giản, nhẹ nhàng, thoải mái và hiệu quả hơn rất nhiều. Khi đó, bạn chỉ việc chọn và sắp xếp những viên gạch có sẵn ấy cho phù hợp với từng ý đồ cụ thể.

Một ví dụ minh hoạ:
Cho trước một polyline. Lập chương trình lấy toạ độ tất cả các đỉnh của nó và ghi kết quả dạng x/y tại mỗi đỉnh.

Nếu không có sự kế thừa, làm từ đầu đến cuối theo yêu cầu trên cũng… toát mồ hôi hột! May thay, trong “kho tài nguyên” của chúng ta đã có sẵn các “viên gạch” phù hợp:
- GetVert: lấy toạ độ tất cả các đỉnh của polyline, kết quả return là 1 list of points
- Wtxt: ghi text ra màn hình, với 2 đối số là text (string) và điểm chuẩn (point)
- Nếu polyline là closed, điểm đầu và cuối trùng nhau, nhưng kết quả return của GetVert vẫn lấy đủ, tức là có 1 kết quả thừa. Hàm DelSame có nhiệm vụ bỏ bớt các item trùng nhau trong một list bất kỳ.



Các “functions – viên gạch” trên mang tính tổng quát, không phụ thuộc vào đặc điểm riêng của một tình huống cụ thể nào, đã được kiểm nghiệm qua nhiều lần sử dụng và xem như đã chuẩn hoá. Ta cứ vô tư lấy ra mà dùng.
Công việc còn lại chỉ là coding mấy dòng đơn giản:



Cách làm trên không riêng gì Lisp, với bất kỳ ngôn ngữ lập trình nào cũng vậy thôi. Người ta vẫn thường tạo ra các hàm, thủ tục, module… có chức năng tổng quát, có thể sử dụng được trong nhiều chương trình khác nhau, lưu trữ chúng trong các thư viện với nhiều định dạng khác nhau, cần đến cái nào cứ lôi cái đó ra mà “chơi”.
Cách gọi của những tài nguyên này tuỳ theo ngôn ngữ lập trình. Ngôn ngũ Lisp không có sự phân biệt, tất cả các hàm đều có một tên gọi chung là Function và được “đối xử” hoàn toàn bình đẳng. Người lập trình tự phân tích, nhìn nhận, chọn trong các functions mình đã lập những “chú” nào có khả năng “tái sử dụng” thì tách riêng nó ra, chăm chút, chỉnh sửa, hoàn thiện và đưa vào “kho lưu trữ”.
Để phân biệt với các functions khác (mang nhiều tính chất riêng tư, chỉ có tác dụng trong một chương trình cụ thể nào đó) ta có thể đặt cho các functions đã chọn lọc nói trên một cái tên: “Public Functions – các hàm dùng chung”.


B- ĐẶT VẤN ĐỀ
Ai đã từng lập trình với Lisp một thời gian có lẽ cũng đã tự “tích cóp” cho mình một “kho tài nguyên” về các Public Functions. Ssg lập topic này với mong muốn cộng đồng lập trình viên Lisp của CadViet cùng nhau giao lưu, chia sẻ, gom góp lại để tạo nên một kho tài nguyên lớn hơn, hoành tráng hơn, hiệu quả hơn với tên gọi CadViet’s AutoLisp Public Functions Library



C- KẾ HOẠCH THỰC HIỆN
Gồm các bước sau:

1. Thu thập
Rất đơn giản, ai có cái gì hay thì post lên để anh em cùng “ngâm cứu”

2. Phân tích và chỉnh sửa
Phân tích ưu nhược điểm, chỉnh sửa code cho hay hơn, gọn gàng hơn, tổng quát hơn, phạm vi áp dụng rộng rãi hơn… Đây là bước quan trọng, đòi hỏi trí tuệ tập thể cao nhất.

3. Thử nghiệm và chuẩn hoá
Mỗi người tự áp dụng trong các chương trình của mình, phát hiện các sai sót, đề xuất các sửa đổi tinh tế hơn. Khi không còn ai ý kiến ý cò gì khác, tạm thời xem như đã được chuẩn hoá, cứ y như vậy và vô tư dùng.

4. Hệ thống hoá
Khi đã thu thập được kha khá, cần hệ thống lại để tiện tra cứu và sử dụng. Việc này đơn giản thôi, chỉ cần lập bảng thống kê tương tự như Help của Acad đã làm theo 2 dạng:
- Theo nhóm chức năng
- Theo ABC

5. Phát triển
Không ngừng hoàn thiện và bổ sung trong quá trình sử dụng

Lưu ý:
Các bạn mới tiếp cận với Lisp cũng đừng ngại ngần. Có thể các bạn chưa hiểu hết ý tứ của các code trong chương trình, nhưng các bạn vẫn sử dụng chúng rất hiệu quả. Điều quan trọng là phải cung cấp đủ và đúng kiểu các đối số mà function đó yêu cầu. Qua sử dụng, dần dần các bạn sẽ hiểu ra nhiều vấn đề. Có khó khăn gì cứ nêu lên, anh em sẽ hỗ trợ.

Mong rằng các bạn sẽ ủng hộ và cùng nhau chung sức phát triển topic này.
Cám ơn tất cả các bạn,
Ssg
<<

Filename: 47468_vd.lsp
Tác giả: zoro107
Bài viết gốc: 172989
Tên lệnh: ac
dùng lệnh Array cho một đường bất kỳ

có 3 cách:
1. dùng lệnh divide (DIV) áp dụng cho pl,spl,line,arc.. cách này không quan tâm đến khoảng cách chia mà chỉ quan tâm đến số lượng Block cần chia.
2. dùng lệnh measure(ME) giống như trên nhưng nó quang tâm đến khoảng cách chia.
3.dùng lisp AC của cadviet :D (cái này có vẽ đáp ứng yêu cầu...
>>
có 3 cách:
1. dùng lệnh divide (DIV) áp dụng cho pl,spl,line,arc.. cách này không quan tâm đến khoảng cách chia mà chỉ quan tâm đến số lượng Block cần chia.
2. dùng lệnh measure(ME) giống như trên nhưng nó quang tâm đến khoảng cách chia.
3.dùng lisp AC của cadviet :D (cái này có vẽ đáp ứng yêu cầu bạn đấy)
lúc xài hãy dùng lệnh UCS > E > nhấp vào đoạn thằng bạn muốn chia trên nó > rồi chọn điểm đầu và đích > số Block cần chia là ok

nội dụng lisp AC của các pro Cadviet đê:


;; free lisp from cadviet.com
;;; this lisp was downloaded from http://www.cadviet.c...6927
(defun c:ac (/ dt p1 p2 sl index kc goc)
(init)
(setq dt (ssget)
p1 (getpoint "\nVao diem goc: ")
p2 (getpoint p1 "\nVao diem den: ")
sl (getint "\nVao so lan: ")
goc (angle p1 p2)
kc (distance p1 p2)
index 0
)
(luuos)
(setvar "osmode" 0)
(repeat sl
(setq index (1+ index))
(command ".copy" dt "" p1 (polar p1 goc (* kc index)))
)
(traos)
(done)
)
;;------------------------------------------------------------
(defun hoanh_newerror (msg)
(if (and (/= msg "Function cancelled")
(/= msg "quit / exit abort")
)
(princ (strcat "\n" msg))
)
(done)
)
;;----------
(defun init ()
(setq
HOANH_CMD (getvar "CMDECHO")
HOANH_OLDERROR *error*
*error* hoanh_newerror
)
(setvar "CMDECHO" 0)
(command ".undo" "BE")
)
;;----------
(defun done ()
(command ".redraw")
(command ".undo" "E")
(if HOANH_CMD
(setvar "CMDECHO" HOANH_CMD)
)
(if HOANH_OLDERROR
(setq *error* HOANH_OLDERROR)
)
(princ)
)
;;----------
(defun luuos ()
(setq
HOANH_OSMODE (getvar "OSMODE")
HOANH_AUTOSNAP (getvar "AUTOSNAP")
)
)
(defun traos ()
(if HOANH_OSMODE
(setvar "OSMODE" HOANH_OSMODE)
)
(if HOANH_AUTOSNAP
(setvar "AUTOSNAP" HOANH_AUTOSNAP)
)
)

<<

Filename: 172989_ac.lsp
Tác giả: ketxu
Bài viết gốc: 172968
Tên lệnh: ha1
Vẽ Line, sau đó break các đối tượng nằm dưới

Các bạn tự sửa theo ghi chú trong Code, rồi bỏ dấu ; đằng trước dòng đó đi để nó có hiệu lực, hoặc bỏ qua :
- Sửa TEN LAYER CHUA NET DUT thành tên layer chứa nét đứt trong bản vẽ
- Sửa Mau thành màu của Line kẻ
- Bỏ dấu ; ở dòng ;ss (vl-remove-if-not... nếu muốn lisp chỉ xử lý thằng nào cùng phương với vector (p1, p2)

Filename: 172968_ha1.lsp
Tác giả: Tue_NV
Bài viết gốc: 62514
Tên lệnh: sct
Sửa Lisp xoay thành scale đối tượng tại tâm


Mở rộng với mọi đối tượng thì tâm được định nghĩa như thế nào ???

Đây là code scale n đường tròn tại tâm của đường tròn

Filename: 62514_sct.lsp
Tác giả: mr.nguyen08ql
Bài viết gốc: 173420
Tên lệnh: rdt dtd rtd vdd
Xin giúp chỉnh sửa đơn giản lisp rải taluy.
Bác ahm, muốn sữa cái nào thì bác phải đưa ra thì mới có người sữa được chứ.
Em thấy có cái Lisp rải đối tượng theo đường dẫn này của bác Duy782006 này cũng hay, thích ngắn dài hay mấy layer do mình.

(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command...
>>
Bác ahm, muốn sữa cái nào thì bác phải đưa ra thì mới có người sữa được chứ.
Em thấy có cái Lisp rải đối tượng theo đường dẫn này của bác Duy782006 này cũng hay, thích ngắn dài hay mấy layer do mình.

(Defun c:rdt (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(hoikieurai)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:dtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(choncuver)
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(command "undo" "end")
(princ (strcat "\nChieu dai doan do la: " (rtos chieudaidoan 2 4)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun c:rtd (/ ss doituong dsl dc ddd chondd chieudaicuver diemdau diemcuoi krai chieudaidoan slc sl index d2 p2 d5 p5 d3 p3 dt l m daidendiem)
(vl-load-com)
(command "undo" "be")
(command "ucs" "")
(chonnhomdoituong)
(choncuver)
(chondiemxuatphat)
(hoikieuraicd)
(command "ucs" "p")
(command "undo" "end")
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun dotructiep ()
(cdxuatphatdo)
(cdketthucdo)
(Cond
((< daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidenhuongdo daidendiemdo)))
((> daidendiemdo daidenhuongdo) (setq chieudaidoan (- daidendiemdo daidenhuongdo)))
)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphatdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuando (getpoint "\nTu diem :"))
(setvar "osmode" 0)
(setq daidendiemdo (vlax-curve-getDistAtPoint chondd diemchuando))
(setvar "osmode"luubatdiem)
(cond
((= daidendiemdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphatdo))
((/= daidendiemdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthucdo ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuongdo (getpoint diemchuando"\nDen diem :"))
(setvar "osmode" 0)
(setq daidenhuongdo (vlax-curve-getDistAtPoint chondd diemdinhhuongdo))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuongdo nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthucdo))
((/= daidenhuongdo nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdxuatphat ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemchuan (getpoint "\nDiem bat dau rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidendiem (vlax-curve-getDistAtPoint chondd diemchuan))
(setvar "osmode"luubatdiem)
(cond
((= daidendiem nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdxuatphat))
((/= daidendiem nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun cdketthuc ()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 545)
(setq diemdinhhuong (getpoint diemchuan"\nDiem ket thuc rai tren duong dan:"))
(setvar "osmode" 0)
(setq daidenhuong (vlax-curve-getDistAtPoint chondd diemdinhhuong))
(setvar "osmode"luubatdiem)
(cond
((= daidenhuong nil) (princ "\nDiem vua chon khong nam tren duong dan, chon lai:") (cdketthuc))
((/= daidenhuong nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun thongbaoketqua ()
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) doanhienthinoidung))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemxuatphat ()
(cdxuatphat)
(cdketthuc)
(Cond
((< daidendiem daidenhuong) (setq chieudaitinh (- daidenhuong daidendiem)) (setq dautinh +))
((> daidendiem daidenhuong) (setq chieudaitinh (- daidendiem daidenhuong)) (setq dautinh -))
)
(setq doanxuatphat daidendiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieuraicd ()
(setq kraicd (strcase (getstring "\nKieu rai theo: Tinh /So luong/")))
(Cond
((= kraicd "T") (raisoluongtinh))
((/= kraicd "T")
(Cond
((= kraicd "S") (raisoluongcd))
((/= kraicd "S") (raikhoangcachcd))
)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongtinh ()
(setq slrai (getreal "\nRai them may lan khong tinh doi tuong tai diem bat dau rai:"))
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(setq tongdoan (* slrai chieudaidoan))
(Cond
((> tongdoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4) "x" (rtos slrai 2 0) "=" (rtos tongdoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raisoluongtinh))
((< tongdoan chieudaitinh)
(setq sl (fix (+ slrai 1)))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slrai 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcachcd ()
(setq chieudaidoan (GETDIST "\nKhoang cach 1 lan rai: "))
(Cond
((= chieudaidoan 0) (dotructiep)))
(Cond
((> chieudaidoan chieudaitinh)
(princ (strcat "\nChieu dai doan la: " (rtos chieudaitinh 2 4) ", Yeu cau la: " (rtos chieudaidoan 2 4)))
(princ "\nVuot qua chieu dai cho phep, nhap lai:")
(raikhoangcachcd))
((< chieudaidoan chieudaitinh)
(setq sol (+ (/ chieudaitinh chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos sol 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
)
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluongcd ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaitinh slc))
(setq sl (fix (+ 1 slc)))
(setq doanhienthinoidung (strcat "\nDa thuc hien rai: " (rtos slc 2 0) " lan voi khoang cach " (rtos chieudaidoan 2 4)))
(thuchienrai)
(princ)
)
;;;;;;;;;;;;;;
(Defun chonnhomdoituong ()
(princ "\nChon doi tuong rai:")
(setq ss (ssget))
(cond
((= ss nil) (princ "\nChua chon duoc doi tuong nao:") (chonnhomdoituong))
((/= ss nil)
(setq dsl (sslength ss))
(cond
((= dsl 1)
(setq doituong (ssname SS 0))
(setq doituong (entget doituong))
(setq KIEUDOITUONG (cdr (assoc 0 doituong)))
(cond
((= KIEUDOITUONG "INSERT") (setq dc (cdr (assoc 10 doituong))))
((/= KIEUDOITUONG "INSERT") (chondiemchuandoituong))
);ketthuccondxemblock
);kethucdsl1
((/= dsl 1) (chondiemchuandoituong))
);ketthuccondnho
);ketthucsetqdsl
);ketthuccondtong
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun chondiemchuandoituong ()
(setq dc (getpoint "\nChon diem goc: "))
(cond
((= dc nil) (princ "\nChua chon duoc diem goc:") (chondiemchuandoituong))
((/= ss nil)))
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun choncuver ()
(setq ddd (entsel "\nChon duong dan:"))
(while
(or
(null ddd)
(or (= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (= "HATCH" (cdr (assoc 0 (entget (car ddd))))) (= "INSERT" (cdr (assoc 0 (entget (car ddd))))) (= "REGION" (cdr (assoc 0 (entget (car ddd))))) (= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong khong the lam duong dan! Chon lai"))
)
(setq chondd (car ddd))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq chieudaicuver (vlax-curve-getDistAtParam chondd (vlax-curve-getEndParam chondd)))
(setq doanxuatphat 0)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;
(Defun hoikieurai ()
(setq dautinh +)
(setq krai (strcase (getstring "\nKieu rai theo: So luong/")))
(Cond
((= krai "S") (raisoluong))
((/= krai "S")(raikhoangcach))
)
(princ)
)
;;;;;;;;;;;;;;
(Defun raikhoangcach ()
(setq chieudaidoan (GETDIST "\nKhoang cach doan chia: "))
(setq sol (+ (/ chieudaicuver chieudaidoan) 1))
(setq sl (fix sol))
(setq sl (fix sl))
(thuchienrai)
(princ)
)
;;;;;;;;;;;;;;
(Defun raisoluong ()
(setq slc (getreal "\nChia duong dan thanh may lan:"))
(setq chieudaidoan (/ chieudaicuver slc))
(setq sl (fix (+ 1 slc)))
(thuchienrai)
(princ)
)
;;;;;;;;;;;;;;
(Defun thuchienrai (/ quaykhong)
(setq quaykhong (strcase (getstring "\nCo quay doi tuong vuong goc voi duong dan khong: Khong/")))
(Cond
((= quaykhong "K") (setq copygiua copykoquay))
((/= quaykhong "K")(setq copygiua copyquay))
)
(setq index -1)
(repeat sl
(setq index (1+ index))
(setq d2 (dautinh doanxuatphat (* chieudaidoan index)))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq p2 (vlax-curve-getPointAtDist chondd d2))
(setvar "osmode"luubatdiem)
(copygiua)
)
(thongbaoketqua)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun copycuoiquay()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d5 (- (dautinh doanxuatphat (* chieudaidoan index)) 0.01))
(setq p5 (vlax-curve-getPointAtDist chondd d5))
(setq L 0)
(setq M (sslength ss))
(while (< L M)
(setq DT (ssname ss L))
(command ".copy" DT "" dc p2)
(command ".rotate" "last" "" p2 p5)
(command ".rotate" "last" "" p2 180)
(setq L (1+ L))
)
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYQUAY(/ p3)
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(setq d3 (+ (dautinh doanxuatphat (* chieudaidoan index)) 0.001))
(setq p3 (vlax-curve-getPointAtDist chondd d3))
(setvar "osmode"luubatdiem)
(Cond
((= p3 nil) (copycuoiquay))
((/= p3 nil)
(setq L 0)
(setq M (sslength ss))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(while (< L M)
(setq DT (ssname ss L))
(command ".copy" DT "" dc p2)
(command ".rotate" "last" "" p2 p3)
(setq L (1+ L))
)
(setvar "osmode"luubatdiem)
)
)

(princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;
(defun COPYKOQUAY()
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command ".copy" ss "" dc p2 "")
(setvar "osmode"luubatdiem)
(princ)
)
;;;;;;;;;;;;;;
(Defun c:vdd ()
(setq ddd (entsel "\nChon duong dan:"))
(while
(or
(null ddd)
(or (= "TEXT" (cdr (assoc 0 (entget (car ddd))))) (= "MTEXT" (cdr (assoc 0 (entget (car ddd))))) (= "HATCH" (cdr (assoc 0 (entget (car ddd))))) (= "INSERT" (cdr (assoc 0 (entget (car ddd))))) (= "REGION" (cdr (assoc 0 (entget (car ddd))))) (= "DIMENSION" (cdr (assoc 0 (entget (car ddd)))))
)
)
(setq ddd (entsel "\nDoi tuong khong the lam duong dan! Chon lai"))
)
(setq chondd (car ddd))
(setq L (vlax-curve-getDistAtParam chondd (vlax-curve-getEndParam chondd)))
(setq diemdau (vlax-curve-getPointAtDist chondd 0))
(setq diemcuoi (vlax-curve-getPointAtDist chondd l))
(setq dc (getpoint "\nChon diem goc: "))
(command ".line" dc diemcuoi "")
(command ".line" dc diemdau "")
(princ)
)

<<

Filename: 173420_rdt_dtd_rtd_vdd.lsp
Tác giả: Doan Van Ha
Bài viết gốc: 173489
Tên lệnh: ins
Tác giả: Nguyen Hoanh
Bài viết gốc: 4914
Tên lệnh: mcaltext
Viết Lisp theo yêu cầu


Tên lênh là MCALTEXT.

Filename: 4914_mcaltext.lsp
Tác giả: Nguyen Hoanh
Bài viết gốc: 6881
Tên lệnh: acd
Viết Lisp theo yêu cầu

- Lisp được viết trên bất cứ trình soạn thảo nào, ví dụ như notepad, wordpad,... Nhưng tốt nhất là nên sử dụng Visual Lisp Editor nằm trong bộ AutoCAD bằng lệnh Vlide vì sự trực quan lúc soạn thảo của nó cũng như các chức năng gỡ rối, biên dịch....

- Lisp dưới đây là lệnh array bạn cần. Cách sử dụng: giống lệnh copy. Bạn chọn tập đối tượng, sau đó chọn điểm gốc,...
>>

- Lisp được viết trên bất cứ trình soạn thảo nào, ví dụ như notepad, wordpad,... Nhưng tốt nhất là nên sử dụng Visual Lisp Editor nằm trong bộ AutoCAD bằng lệnh Vlide vì sự trực quan lúc soạn thảo của nó cũng như các chức năng gỡ rối, biên dịch....

- Lisp dưới đây là lệnh array bạn cần. Cách sử dụng: giống lệnh copy. Bạn chọn tập đối tượng, sau đó chọn điểm gốc, tiếp đến chọn hướng copy (các đối tượng sẽ được array theo hướng mà bạn pick), và cuối cùng là nhập vào các khoảng cách để lisp array.

Nếu bạn lấy dữ liệu bên excel, hãy sắp xếp các số liệu trên 1 cột của excel, nhấn Ctr+C, rồi quay sang CAD dùng lệnh ACD, lúc chương trình hỏi về các khoảng cách thì bạn nhấn Ctr+V.


<<

Filename: 6881_acd.lsp
Tác giả: Tue_NV
Bài viết gốc: 173524
Tên lệnh: inn
Viết lisp Break Pline tại điểm chèn Block.

Của bạn đây. Bạn thử nhé :

Filename: 173524_inn.lsp
Tác giả: phamngoctukts
Bài viết gốc: 109980
Tên lệnh: att
Viết lisp theo yêu cầu [phần 2]

Của bạn đây.

http://www.cadviet.com/upfiles/3/att.png
Mình chưa có thời gian kiểm tra nên tạm phân ra làm 2 trường hợp.
BS: khoảng cách từ 0 tới A phải bằng từ 0 tới B

Filename: 109980_att.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 109997
Tên lệnh: tktxt
Viết lisp theo yêu cầu [phần 2]

Hề hề hề,
Xong rồi, cuối cùng cũng nghĩ ra được giải pháp chung nhất, bắt chấp kích thước đường kinh và kích thước chiều dài của ống. Chỉ cần bạn Truongthanh nhập tẽt theo đúng điều kiện như sau: giữa các ký tự chỉ đường kính ống và gạch nối là một khoảng trắng, giữa gạch nối và các ký tự chiều dài ống là một khoảng trắng,
giữa các ký tự chỉ chiều dài...
>>

Hề hề hề,
Xong rồi, cuối cùng cũng nghĩ ra được giải pháp chung nhất, bắt chấp kích thước đường kinh và kích thước chiều dài của ống. Chỉ cần bạn Truongthanh nhập tẽt theo đúng điều kiện như sau: giữa các ký tự chỉ đường kính ống và gạch nối là một khoảng trắng, giữa gạch nối và các ký tự chiều dài ống là một khoảng trắng,
giữa các ký tự chỉ chiều dài và gạch nối phía sau cũng là một khoảng trắng (trong trường hợp ống thoát nước) là OK.
Cũng giống lisp trước bạn Truongthanh phải lưu ý là nội dung kê khai trong bảng thống kê với ống cấp nước sẽ luôn là ỐNG NHỰA uPVC và kích thước đường kính ống, còn trong bảng thống kê cho đường ống thoát nước luôn là CỐNG BTCT và đường kính ống bạn nhé.
Cái vụ này là do bản mẫu của bạn như vậy, nếu bạn muốn thay đổi cái tên khác thì bạn phải thay đổi cái biến prtxt trong hàm chính bạn nhé.
Hy vọng bạn sẽ hài lòng.


PS: Bạn hãy chú ý so sánh hai cái lisp của mình để thấy được sự khác nhau giữa hai cách tách chuỗi bạn nhé. Cách sau tuy phức tạp nhưng giải quyết được vấn đề triệt để hơn bạn ạ. Qua đó bạn cũng se4ho5c được một số cái hay hay đó. Chúc bạn vui.
<<

Filename: 109997_tktxt.lsp
Tác giả: Phiphi-
Bài viết gốc: 110151
Tên lệnh: l2f
Viết lisp theo yêu cầu [phần 2]
Nhờ bác Tue_NV bổ sung thêm đoạn code dưới đây chính do bác viết để có thể lấy thêm code màu của các layers luôn.
Cám ơn Bác nhiều.

Filename: 110151_l2f.lsp
Tác giả: ndtnv
Bài viết gốc: 110157
Tên lệnh: ptt
Viết lisp theo yêu cầu [phần 2]

Mình thấy bạn cũng giống như bạn phamthanhbinh cách đây vài năm là
mặc dù chưa biết nhiều về lisp nhưng vẫn tích cực viết chương trình.
Mặc dù bạn Tue_NV đã viết rồi nhưng mình cũng sửa lại code của bạn với vài góp ý sau:
- Vẽ ARC có nhiều cách, ta tìm cách nào dễ tính toán là được. Trong lisp này mình chọn (Start, End, Direction)
- Cho hẳn điểm P1 nằm trên đường...
>>

Mình thấy bạn cũng giống như bạn phamthanhbinh cách đây vài năm là
mặc dù chưa biết nhiều về lisp nhưng vẫn tích cực viết chương trình.
Mặc dù bạn Tue_NV đã viết rồi nhưng mình cũng sửa lại code của bạn với vài góp ý sau:
- Vẽ ARC có nhiều cách, ta tìm cách nào dễ tính toán là được. Trong lisp này mình chọn (Start, End, Direction)
- Cho hẳn điểm P1 nằm trên đường thứ nhất, P2 nằm trên đường thứ hai thì sẽ bớt nhiều phép so sánh.
- Hạn chế dùng biến GLOBAL, chỉ dùng khi cần thiết.
Các dòng comment là code đầy đủ của tính toán P1&P2 , bạn xem sẽ thấy dễ hiểu hơn

<<

Filename: 110157_ptt.lsp
Tác giả: phamngoctukts
Bài viết gốc: 110413
Tên lệnh: keol
Viết lisp theo yêu cầu [phần 2]

Của bạn đây. Bạn có thể chọn nhiều đường line cuòng một lúc. Chú ý các đường line này lấy gốc là điểm bắt đầu vẽ line

Filename: 110413_keol.lsp
Tác giả: 790312
Bài viết gốc: 129877
Tên lệnh: h1
Viết lisp theo yêu cầu [phần 2]
Nhờ các bác sửa giúp giùm e,sao dùng phím tắt thì được nhưng chọn trực tiếp thì không hiển thị đúng HATCH.

;; free lisp from cadviet.com
(defun c:h1()
(initget 1 "2 ANSI32 3 ANSI33 4 ANSI34 7 ANSI37 SO SOLID AR AR-CONC B BRICK")
(setq s1 (getkword "\nANSI32/ANSI33/ANSI34/ANSI37/SOLID/AR-CONC/BRICK "))
(cond
((= "2" (strcase s1)) (SetHvar "ANSI32" hScale hAng hAssoc hGap))
>>
Nhờ các bác sửa giúp giùm e,sao dùng phím tắt thì được nhưng chọn trực tiếp thì không hiển thị đúng HATCH.

;; free lisp from cadviet.com
(defun c:h1()
(initget 1 "2 ANSI32 3 ANSI33 4 ANSI34 7 ANSI37 SO SOLID AR AR-CONC B BRICK")
(setq s1 (getkword "\nANSI32/ANSI33/ANSI34/ANSI37/SOLID/AR-CONC/BRICK "))
(cond
((= "2" (strcase s1)) (SetHvar "ANSI32" hScale hAng hAssoc hGap))
((= "3" (strcase s1)) (SetHvar "ANSI33" hScale hAng hAssoc hGap))
((= "4" (strcase s1)) (SetHvar "ANSI34" hScale hAng hAssoc hGap))
((= "7" (strcase s1)) (SetHvar "ANSI37" hScale hAng hAssoc hGap))
((= "SO" (strcase s1)) (SetHvar "SOLID" 1 0 1 20))
((= "AR" (strcase s1)) (SetHvar "AR-CONC" 1 0 1 20))
((= "B" (strcase s1)) (SetHvar "BRICK" 1 0 1 20))
);end cond
(command "-hatch")
(while (< 0 (getvar "CMDACTIVE")) (command pause))
(acet-sysvar-restore)
);END C:
(defun SetHvar ( hName hScale hAng hAssoc hGap) ;hLayer)
(acet-sysvar-set (list "hpname" hname "hpscale" hScale "hpang" hAng "hpassoc" hAssoc "hpgaptol" hgap
"clayer" "S13. HATCH" "HPSEPARATE" 1))
)

Chân thành cảm ơn trước.
<<

Filename: 129877_h1.lsp
Tác giả: phamthanhbinh
Bài viết gốc: 131698
Tên lệnh: cd
Viết lisp theo yêu cầu [phần 2]

Hề hề hề,
Có phải bạn cần cái này không???
Hãy dùng thử và cho ý kiến xem cần chỉnh sửa thêm gì nhé.

Chúc bạn vui.

Filename: 131698_cd.lsp

Trang 55/316

55