Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#441 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 30 November 2009 - 07:53 AM

Chào bạn quynhnn,
Bạn dùng thử lisp này coi sao. Dựa trên sự gợi ý của bác Gia bach mình viết lại. Nếu có gì chưa vừa ý, hãy post lên nhé.

(defun c:chla (/ nla ss n i lst ent la lsol m )
(setq nla (getstring "\n Nhap ten layer dich: "))
(if (not (tblsearch "layer" nla))
(command "layer" "n" nla "c" "red" nla "")
)
(setq ss (ssget)
n (sslength ss)
i 0 )
(while (< i n)
(setq ent (ssname ss i)
lst (entget ent))
(if (= (assoc 62 lst) nil)
(progn
(setq la (cdr (assoc 8 lst)))
(setq lsol (tblnext "layer" T))
(while (/= la (cdr (assoc 2 lsol)))
(setq lsol (tblnext "layer"))
)
(setq m (cdr(assoc 62 lsol)))
(setq lst (append lst (list (cons 62 m))))
(entmod lst)
)
)
(setq i (1+ i))
)
(command "change" ss "" "p" "la" nla "")
(princ)
)

Chúc bạn vui.

Chào bác phamthanhbinh
Mặc dù Lisp chla cho kết quả chính xác nhưng Bác có thể tối ưu Lisp trên bằng cách thay thế 3 dòng :
(setq lsol (tblnext "layer" T))
(while (/= la (cdr (assoc 2 lsol)))
(setq lsol (tblnext "layer"))
)

bằng dòng : (setq lsol (tblsearch "layer" la))
  • 2

#442 quynhnn

quynhnn

    biết zoom

  • Members
  • Pip
  • 15 Bài viết
Điểm đánh giá: 1 (bình thường)

Đã gửi 30 November 2009 - 08:41 AM

Tốt quá rồi. Cảm ơn các bác
  • 0

#443 chandatn

chandatn

    biết pan

  • Members
  • Pip
  • 9 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 30 November 2009 - 10:15 AM

[quote name='phamthanhbinh' date='Nov 28 2009, 17:14' post='80492']
Chào bác Tue_NV,
Bác xem lại xem vì dòng code (command "change" ss "" "p" "la" nla "LT" (cdr(assoc 6 lsol)) "") này nằm ngoài vòng lặp Whlie cho nên hàm (cdr(assoc 6 lsol)) sẽ nhận giá trị của linetype ở lớp cuối cùng chứa đối tượng có màu là bylayer.
Do vậy tất cả tập chọn ss đều bị đổi thành linetype này chứ không giữ nguyên được linetype của nó như cũ bác ạ.
Cái lisp của mình sẽ giữ nguyên linetype của đối tượng nếu như nó không phải là bylayer.
Để có thể thỏa mãn yêu cầu của bạn chandatn theo mình hiểu thì cũng phải làm y như đối với việc giữ màu của đối tượng vậy, nghĩa là trước hết phải đổi linetype của đối tượng từ bylayer thành linetype có tên tương ứng, tức là làm cho đối tượng có thêm mã DXF số 6 bác ạ.
Cám ơn các bác nhiều lắm!
Tôi thấy trình độ của mọi người quả là siêu phàm. Trình độ của tôi ABC quá nên phải nhờ vả mọi người chỉ dẫn thêm!
Nếu muốn biết các mã của DXF (như ví dụ như mã DXF số 6 để đọc linetype ) thì xem ở đâu các bac
  • 0

#444 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 30 November 2009 - 10:58 AM

......................................
Nếu muốn biết các mã của DXF (như ví dụ như mã DXF số 6 để đọc linetype ) thì xem ở đâu các bac

Bạn xem trong Help Developer Documentation : DXF Reference
Chú ý tab ENTITIES Section
Hình đã gửi
  • 0

#445 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 30 November 2009 - 11:18 AM

Chào bác Tue_NV,
Bác xem lại xem vì dòng code (command "change" ss "" "p" "la" nla "LT" (cdr(assoc 6 lsol)) "") này nằm ngoài vòng lặp Whlie cho nên hàm (cdr(assoc 6 lsol)) sẽ nhận giá trị của linetype ở lớp cuối cùng chứa đối tượng có màu là bylayer.
Do vậy tất cả tập chọn ss đều bị đổi thành linetype này chứ không giữ nguyên được linetype của nó như cũ bác ạ.
Cái lisp của mình sẽ giữ nguyên linetype của đối tượng nếu như nó không phải là bylayer.
Để có thể thỏa mãn yêu cầu của bạn chandatn theo mình hiểu thì cũng phải làm y như đối với việc giữ màu của đối tượng vậy, nghĩa là trước hết phải đổi linetype của đối tượng từ bylayer thành linetype có tên tương ứng, tức là làm cho đối tượng có thêm mã DXF số 6 bác ạ.
Cám ơn các bác nhiều lắm!
Tôi thấy trình độ của mọi người quả là siêu phàm. Trình độ của tôi ABC quá nên phải nhờ vả mọi người chỉ dẫn thêm!
Nếu muốn biết các mã của DXF (như ví dụ như mã DXF số 6 để đọc linetype ) thì xem ở đâu các bac

Chào bạn chandatn,
Tất cả các đối tượng trong Cad đều được quản lý bởi các mã DXF của chúng. Để xem các mã DXF của một đối tượng bạn sử dụng hàm (entget(car(entsel))) và chọn đối tượng muốn xem.
Để hiểu được các mã này bạn nên tìm hiểu kỹ trong phần hướng dẫn Help của CAD.
Việc hiểu các mã này không quá khó, chỉ cần bạn lưu tâm thì sau một thời gian ngắn bạn sẽ rõ. Việc thuộc các mã này sẽ giúp bạn thuận lợi hơn khi sử dụng nhưng không nhất thiết phải thuộc đâu bạn ạ. Nó khá nhiều và bạn chỉ cần nhớ vài cái chính hay dùng, còn đâu thì mỗi khi cần dùng bạn có thể mở Help ra để tham khảo lại cũng nhanh thôi.
Bạn có thể tham khảo các bài hướng dẫn lập trình lisp có trên diễn đàn và thực hành dần dần sẽ quen thôi, đừng ngại nếu gặp phải khó khăn. Bất cứ khi nào bạn cần đều có thể post yêu cầu của bạn lên mọi người sẽ hỗ trợ. Tuy nhiên việc bạn hiểu và ứng dụng được lisp vào trong côg việc sẽ giúp bạn làm chủ công việc của mình và chủ động hơn nhiều bạn ạ.
Chúc bạn thành công.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#446 tvduc

tvduc

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 30 November 2009 - 05:09 PM

Nhờ các Bác kiểm tra và thêm một số tùy chọn cho lisp sau nhé:
1- Lưu lai tùy chọn bắt điểm hiện tại.
2- Bật bắt điểm hiện tại là: điểm cuối và giao của các đường thẳng.
3- Kết thúc lệnh phục hồi tùy bắt điểm ban đầu, và xuất hiện nội dung “Can phai chuyen tat cac cac doi tuong dam ve Layer Fram” lên màn hình.

Một số lỗi không biết cách khắc phục:
1- sau mỗi lần chọn đỉnh cọc lại xuất hiện dòng chữ “CS Unknown command "CS". Press F1 for help”
2- Sao lúc Enter kết thúc lệnh thì có báo lỗi như sau:
; error: bad argument type: numberp: nil

Cảm ơn các Bác nhé.



; Doi voi mot so ket cau nhu cau tau, tru neo. Thuong co truong hop coc xien trong khong gian,
; Lisp nay giup ve nhanh mo hinh ket cau 3D ngay tren cua so 2D cua ACAD ma khong can phai biet ve trong 3D.
; (chi ve phan coc va dam ....)
; Lenh ve CS
; Huong dan HD

(defun c:cs()
(command "layer" "m" "Fram" "c" 2 "" "")
(princ "\n Lisp Ve coc khong gian - ung dung lap mo hinh cho SAP tu ACAD: Tvduc")
(setq
Lu (getdist "\n Nhap chieu dai chiu uon: ")
m (getdist "\n Nhap do xien cua coc 1/m: ")
)
(while (< m 5)
(alert"Ban oi! Do xien cua coc phai la so duong, va khong duoc xien qua 1/5,lam on nhap lai nhe!")
; Tuy thuoc vao tung cong trinh cu the ma do xien cua coc co the vuot ngoai gia tri tren.
(setq m (getdist "\n Nhap lai do xien cua coc 1/m: "))
)
(while (> m 10)
(alert"Ban oi! Do xien cua coc nho hon 1/10 khong co y nghia, xem lai ket cau nhe!")
(setq m (getdist "\n Nhap lai do xien cua coc 1/m: "))
)
(setq
a (getdist "\n Nhap goc xoay cua coc: ")
)
(while (or (< a -45)(> a 45))
(alert"Ban oi! Góc xoay co gia tri tu -45 den +45 do^. thoi! Lam on nhap lai nhe.")
(setq a (getdist "\n Coc xoay quan truc: "))
; Tuy thuoc tung bai toan cu the.
)
(setq
aa (getdist "\n Coc xoay quan truc: ")
)
(while (and (/= aa 1)(/= aa 2)(/= aa 3)(/= aa 4))
(alert"Ban oi! Chieu duong truc x la truc 1, Chieu duong truc y la truc 2, Chieu am truc x la truc 3, Chieu am truc y la truc 4! Lam on nhap lai nhe.")
(setq aa (getdist "\n Coc xoay quan truc: "))
)
(setq
a (+ (* (- aa 1) 90) a)
xy (/ Lu m)
x (* xy (cos (/ (* a pi) 180)))
y (* xy (sin(/ (* a pi) 180)))
)
(while
(setq
p1 (getpoint "\n Vi tri dinh coc ?")
p2 (list (+ (car p1) x) (+ (cadr p1) y) (- 0 Lu))
)
(command "_line" p1 p2 "" "")
)
(princ "\n Can phai chuyen tat cac cac doi tuong dam ve Layer Fram")
)
(defun c:hd ()
(print "Chieu duong cua goc xoay nguoc chieu voi kim dong ho")
(print "Goc toa do la dinh coc")
(print "Chieu duong truc x la truc 1")
(print "Chieu duong truc y la truc 2")
(print "Chieu am truc x la truc 3")
(print "Chieu am truc y la truc 4")
(princ)
)

  • 0

#447 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 30 November 2009 - 05:24 PM

Lisp này được nhưng bạn thêm vào sao khi ta chọn đường thẳng bất kỳ rồi nhấn số 2 thì đường này chuyển thành màu DUONGBAO nhưng layer hiên hành sẽ chuyển về DUONGBAO luôn.Cảm ơn bạn rất nhiều.


Xin cảm ơn Bác Tuệ đã góp ý. Mình viết lại LISP cho bạn thế này:
(defun c:2(/ Ent_slc OLD_CMD)
(SETQ OLD_CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(princ "\nChon cac doi tuong chuyen sang Layer DUONGBAO: ")
(setq Ent_slc (ssget '((0 . "POLYLINE,LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
(while (not Ent_slc)
(princ "\nChua chon duoc doi tuong: ")
(setq Ent_slc (ssget '((0 . "POLYLINE,LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
)
(command ".change" Ent_slc "" "p" "c" "bylayer" "la" "DUONGBAO" "")
(command "-layer" "S" "DUONGBAO" "")
(SETVAR "CMDECHO" OLD_CMD)
(princ "\nCac doi tuong da chuyen sang Layer DUONGBAO !!!")
(princ)
)

Có gì chưa đúng bạn cứ Post lên.
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#448 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 30 November 2009 - 06:11 PM

Xin cảm ơn Bác Tuệ đã góp ý. Mình viết lại LISP cho bạn thế này:

(defun c:2(/ Ent_slc OLD_CMD)
(SETQ OLD_CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(princ "\nChon cac doi tuong chuyen sang Layer DUONGBAO: ")
(setq Ent_slc (ssget '((0 . "POLYLINE,LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
(while (not Ent_slc)
(princ "\nChua chon duoc doi tuong: ")
(setq Ent_slc (ssget '((0 . "POLYLINE,LINE,LWPOLYLINE,SPLINE,ARC,CIRCLE,ELLIPSE"))))
)
(command ".change" Ent_slc "" "p" "c" "bylayer" "la" "DUONGBAO" "")
(command "-layer" "S" "DUONGBAO" "")
(SETVAR "CMDECHO" OLD_CMD)
(princ "\nCac doi tuong da chuyen sang Layer DUONGBAO !!!")
(princ)
)

Có gì chưa đúng bạn cứ Post lên.

Bạn nên thay hàm while bằng hàm if.
Trường hợp User không muốn chọn đối tượng nào cả thì nhấn Esc thoát vòng lặp While thì không tiện lắm

(defun c:2(/ Ent_slc OLD_CMD)
(SETQ OLD_CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(princ "\nChon cac doi tuong chuyen sang Layer DUONGBAO: ")
(command "-layer" "N" "DUONGBAO" "")

(if (setq Ent_slc (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
(progn
(command ".change" Ent_slc "" "p" "c" "bylayer" "la" "DUONGBAO" "")
(princ "\nCac doi tuong da chuyen sang Layer DUONGBAO !!!")
)
(princ "\nChua chon duoc doi tuong: ")
)

(command "-layer" "S" "DUONGBAO" "")
(SETVAR "CMDECHO" OLD_CMD)

(princ)
)

  • 2

#449 dkkx3a

dkkx3a

    biết lệnh trim

  • Members
  • PipPipPip
  • 190 Bài viết
Điểm đánh giá: 57 (tàm tạm)

Đã gửi 30 November 2009 - 09:22 PM

Bạn nên thay hàm while bằng hàm if.
Trường hợp User không muốn chọn đối tượng nào cả thì nhấn Esc thoát vòng lặp While thì không tiện lắm

(defun c:2(/ Ent_slc OLD_CMD)
(SETQ OLD_CMD (GETVAR "CMDECHO"))
(SETVAR "CMDECHO" 0)
(princ "\nChon cac doi tuong chuyen sang Layer DUONGBAO: ")
(command "-layer" "N" "DUONGBAO" "")

(if (setq Ent_slc (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
(progn
(command ".change" Ent_slc "" "p" "c" "bylayer" "la" "DUONGBAO" "")
(princ "\nCac doi tuong da chuyen sang Layer DUONGBAO !!!")
)
(princ "\nChua chon duoc doi tuong: ")
)

(command "-layer" "S" "DUONGBAO" "")
(SETVAR "CMDECHO" OLD_CMD)

(princ)
)


Thì mình cũng lưỡng lự khi viết cái này, nhưng bác ấy muốn chọn và ..., nên khi không chọn được thì nó đòi chọn thôi. "không ép mỡ ép duyên nhưng chọn thì.....ép". Hihi. Cảm ơn bác góp ý.
  • 0
TỰ SỰ
Biển vào chiều buồn giữa cô liêu
Sóng vỗ bờ bạc đầu con nước
Khi biển động như lòng ta chợt động
Biển ồn ào nhưng thực rất dịu êm.......

#450 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 30 November 2009 - 10:23 PM

Nhờ các Bác kiểm tra và thêm một số tùy chọn cho lisp sau nhé:
1- Lưu lai tùy chọn bắt điểm hiện tại.
2- Bật bắt điểm hiện tại là: điểm cuối và giao của các đường thẳng.
3- Kết thúc lệnh phục hồi tùy bắt điểm ban đầu, và xuất hiện nội dung “Can phai chuyen tat cac cac doi tuong dam ve Layer Fram” lên màn hình.

Một số lỗi không biết cách khắc phục:
1- sau mỗi lần chọn đỉnh cọc lại xuất hiện dòng chữ “CS Unknown command "CS". Press F1 for help”
2- Sao lúc Enter kết thúc lệnh thì có báo lỗi như sau:
; error: bad argument type: numberp: nil

Cảm ơn các Bác nhé.
(while
(setq
p1 (getpoint "\n Vi tri dinh coc ?")
p2 (list (+ (car p1) x) (+ (cadr p1) y) (- 0 Lu))
)
(command "_line" p1 p2 "" "")
)
(princ "\n Can phai chuyen tat cac cac doi tuong dam ve Layer Fram")
)

Một số lỗi không biết cách khắc phục:
Nó bị lỗi ngay ở các dòng trên
1./ 1- sau mỗi lần chọn đỉnh cọc lại xuất hiện dòng chữ “CS Unknown command "CS". Press F1 for help”
-> Lỗi này là do dòng (command "_line" p1 p2 "" "") -> bạn bị thừa 1 dấu "" -> phải viết là : (command "_line" p1 p2 ""). Dấu "" tương đương với phím Enter nên do bị thừa 1 dấu nên bạn bị lỗi như trên
2- Sao lúc Enter kết thúc lệnh thì có báo lỗi như sau:
; error: bad argument type: numberp: nil


-> Lỗi này là do điều kiện logic của hàm While không đúng -> biến p2 không xác định được và lệnh vẽ LINE trở nên vô nghĩa.
Tức là như thế này :
- Vào vòng While -> Kiểm tra điều kiện của biến P1 (nếu thoả : trường hợp bạn Pick 1 điểm trên màn hình) -> Lisp tính toán điểm P2 và vẽ LINE
. Và Trường hợp Kiểm tra điều kiện của biến P1 = nil (Khi bạn nhấn Enter ). vòng While -> Kiểm tra điều kiện của biến P1 không thoả (P1 =nil) => Kết quả tính toán P2 vô nghĩa và lệnh vẽ LINE bằng hàm Command cũng sẽ trở nên vô nghĩa là nó đã báo lỗi như bạn đã thấy.
- Cách sửa :
+ Vào vòng lặp While với điều kiện logic là kiểm tra P1
-> Dùng hàm if -> kiểm tra P1 -> Nếu P1 thoả -> Tính P2 -> Vẽ LINE. Nếu P1 không thoả sẽ thoát vòng lặp While
Code được sửa lại :

(while (setq p1 (getpoint "\n Vi tri dinh coc ?"))
(if p1
(progn
(setq p2 (list (+ (car p1) x) (+ (cadr p1) y) (- 0 Lu)))
(command "_line" p1 p2 "")
)
);if
);while

Bạn thay code mà Tue_NV đánh dấu màu xanh trong code của bạn và thay bằng code đánh dấu màu hồng mà Tue_NV sửa lại cho bạn và chạy thử nhé
  • 2

#451 tvduc

tvduc

    biết vẽ line

  • Members
  • PipPip
  • 22 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 01 December 2009 - 02:17 PM

Cảm ơn bác Tue_NV nhé, song bác có thể chỉ giáo cho phần tùy chọn bắt điểm có nêu ở trên luôn nhé!
1- Lưu lai tùy chọn bắt điểm hiện tại.
2- Bật bắt điểm hiện tại là: điểm cuối và giao của các đường thẳng.
3- kết thúc sẽ khôi phục lại tùy chọn ban đầu.

hihi tiện thể cho hỏi các bác tí nữa nhé: Trên layout làm sao để lấy được biến scale của 1 cửa sổ nào đó, ví dụ có cửa sổ với tỷ lệ 1/50,
vậy làm thể nào để lấy được giá trị 50 đó để gán cho biến aa chẵng hạn.


; Doi voi mot so ket cau nhu cau tau, tru neo. Thuong co truong hop coc xien trong khong gian,
; Lisp nay giup ve nhanh mo hinh ket cau 3D ngay tren cua so 2D cua ACAD ma khong can phai biet ve trong 3D.
; (chi ve phan coc va dam ....)
; Lenh ve CS
; Huong dan HD

(defun c:cs()
(command "layer" "m" "Fram" "c" 2 "" "")
(princ "\n Lisp Ve coc khong gian - ung dung lap mo hinh cho SAP tu ACAD: Tvduc")
(setq
Lu (getdist "\n Nhap chieu dai chiu uon: ")
m (getdist "\n Nhap do xien cua coc 1/m: ")
)
(while (< m 5)
(alert"Ban oi! Do xien cua coc phai la so duong, va khong duoc xien qua 1/5,lam on nhap lai

nhe!")
; Tuy thuoc vao tung cong trinh cu the ma do xien cua coc co the vuot ngoai gia tri tren.
(setq m (getdist "\n Nhap lai do xien cua coc 1/m: "))
)
(while (> m 10)
(alert"Ban oi! Do xien cua coc nho hon 1/10 khong co y nghia, xem lai ket cau nhe!")
(setq m (getdist "\n Nhap lai do xien cua coc 1/m: "))
)
(setq
a (getdist "\n Nhap goc xoay cua coc: ")
)
(while (or (< a -45)(> a 45))
(alert"Ban oi! Góc xoay co gia tri tu -45 den +45 do^. thoi! Lam on nhap lai nhe.")
(setq a (getdist "\n Coc xoay quan truc: "))
; Tuy thuoc tung bai toan cu the.
)
(setq
aa (getdist "\n Coc xoay quan truc: ")
)
(while (and (/= aa 1)(/= aa 2)(/= aa 3)(/= aa 4))
(alert"Ban oi! Chieu duong truc x la truc 1, Chieu duong truc y la truc 2, Chieu am

truc x la truc 3, Chieu am truc y la truc 4! Lam on nhap lai nhe.")
(setq aa (getdist "\n Coc xoay quan truc: "))
)
(setq
a (+ (* (- aa 1) 90) a)
xy (/ Lu m)
x (* xy (cos (/ (* a pi) 180)))
y (* xy (sin(/ (* a pi) 180)))
)
(while (setq p1 (getpoint "\n Vi tri dinh coc ?"))
(if p1
(progn
(setq p2 (list (+ (car p1) x) (+ (cadr p1) y) (- 0 Lu)))
(command "_line" p1 p2 "")
)
);if
);while

(princ "\n Can phai chuyen tat cac cac doi tuong dam ve Layer Fram")
)
(defun c:hd ()
(print "Chieu duong cua goc xoay nguoc chieu voi kim dong ho")
(print "Goc toa do la dinh coc")
(print "Chieu duong truc x la truc 1")
(print "Chieu duong truc y la truc 2")
(print "Chieu am truc x la truc 3")
(print "Chieu am truc y la truc 4")
(princ)
)

  • 0

#452 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 01 December 2009 - 02:48 PM

Cảm ơn bác Tue_NV nhé, song bác có thể chỉ giáo cho phần tùy chọn bắt điểm có nêu ở trên luôn nhé!
1- Lưu lai tùy chọn bắt điểm hiện tại.
2- Bật bắt điểm hiện tại là: điểm cuối và giao của các đường thẳng.
3- kết thúc sẽ khôi phục lại tùy chọn ban đầu.
......

Bạn có thể làm theo những ý sau :
(defun c:cs()
(setq oldos (getvar "osmode")) ; Luu lai tuy chon bat diem hien tai
(setvar "osmode" 33) ; Bat bat diem hien tai : diem cuoi va giao cua cac duong thang
;;
;;
;; Phan Than cua Code
;;;
;
(setvar "osmode" oldos) ; Ket thuc va khoi phuc lai tuy chon ban dau
);end defun

Để biết bắt điểm điểm cuối và giao của các đường thẳng thì biến osmode nhận giá trị bao nhiêu thì trong CAD bạn cứ thiết lập chế độ bắt điểm điểm cuối và giao của các đường thẳng và gõ Osmode xem biến này nhận giá trị bằng bao nhiêu?

Mình góp ý với bạn 1 tí trong Code của bạn nhé :
-> Không nên sử dụng hàm getdist để nhập góc trong code cụ thể là :
(setq a (getdist "\n Nhap goc xoay cua coc: "))
-> Nên sử dụng hàm getangle để nhập góc -> Kết quả sẽ trả về radian : và trong hàm cos; sin thì bạn không cần phải chuyển sang Radian nữa
(setq a (getangle "\n Nhap goc xoay cua coc: "))
-> Nhập 45 sẽ trả lại kết quả 0.785398 (RAD)
  • 2

#453 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 02 December 2009 - 10:37 AM

...................................

hihi tiện thể cho hỏi các bác tí nữa nhé: Trên layout làm sao để lấy được biến scale của 1 cửa sổ nào đó
.....................................

Bạn tham khảo Lisp sau :
(defun c:svp(/ ent dz Viewport)
(if (/= (getvar "cvport") 1)
(alert "\nChi co the chay tren khong gian giay (LAYOUT).")
(progn (vl-load-com)
(while
(not
(and
(setq ent (car (entsel "\nChon Viewport : ")))
(or
(= (cdr (assoc 0 (entget ent))) "VIEWPORT")
(= (cdr (assoc 0 (entget (setq ent (cdr (assoc 330 (entget ent))))))) "VIEWPORT")
)
)
)
(princ "\nkhong phai Viewport. Chon lai : ")
)
(setq dz (getvar "dimzin"))
(setvar "dimzin" 8 )
(setq Viewport (vlax-Ename->Vla-Object ent)
sc (vla-get-CustomScale Viewport))
(alert (strcat "\nCustom Scale : " (rtos sc) " or " (strcat "1/" (rtos (/ 1 sc)))))
(setvar "dimzin" dz )
)
)
(princ) )

  • 0

#454 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 03 December 2009 - 06:55 PM

Nhờ viết lisp:
trên bản vẽ có các điểm tọa độ, mỗi điểm có nhãn tên điểm và nhãn độ cao đi liền với point nhưng các point có độ cao z=0, muốn chuyển các point về độ cao đúng của nó một cách nhanh nhất.
Đây là file trước khi chuyển :
http://www.cadviet.c...ogopoint1_1.rar
và đây là file sau khi chuyển:
http://www.cadviet.c.../cogopoint2.rar
  • 0

#455 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 04 December 2009 - 08:23 AM

Nhờ viết lisp:
trên bản vẽ có các điểm tọa độ, mỗi điểm có nhãn tên điểm và nhãn độ cao đi liền với point nhưng các point có độ cao z=0, muốn chuyển các point về độ cao đúng của nó một cách nhanh nhất.
Đây là file trước khi chuyển :
http://www.cadviet.c...ogopoint1_1.rar
và đây là file sau khi chuyển:
http://www.cadviet.c.../cogopoint2.rar

Chào tnmtpc
Bạn sử dụng Lisp này thử nhé :

(defun c:MPT(/ ss ss2 i j lis Z p p2 pkt ent L caoZ)
;copyright by Tue_NV
(setq ss (ssget "X" '((0 . "TEXT") (8 . "el"))) i 0 j 0 lis (list) Z (list))
(setq ss2 (ssget "X" '((0 . "POINT") )) )
(while (< i (sslength ss))
(setq p (cdr(assoc 10 (entget (ssname ss i)))))
(setq lis (append lis
(list (list (round (car p) 3) (round (cadr p) 3)) )
)
)
(setq Z (append Z (list (caddr p)))
)
(setq i (1+ i))
)
(while (< j (sslength ss2))
(setq ent (ssname ss2 j))
(setq p2 (cdr(assoc 10 (entget ent))))
(setq pkt (list (round (car p2) 3) (round (cadr p2) 3)) )
(if (setq L (member pkt lis))
(progn
(setq caoZ (nth (- (length lis) (length L)) Z) )
(command "move" ent "" '(0 0 0)
(list 0 0 caoZ)
)
)
)
(setq j (1+ j))
)
)
;
(defun round(so tp)
(setvar "dimzin" 0)
(atof (rtos so 2 tp))
)

  • 1

#456 tnmtpc

tnmtpc

    biết dimcontinue

  • Members
  • PipPipPipPipPip
  • 370 Bài viết
Điểm đánh giá: 206 (khá)

Đã gửi 04 December 2009 - 11:02 AM

Chào tnmtpc
Bạn sử dụng Lisp này thử nhé :


(defun c:MPT(/ ss ss2 i j lis Z p p2 pkt ent L caoZ)
;copyright by Tue_NV
(setq ss (ssget "X" '((0 . "TEXT") (8 . "el"))) i 0 j 0 lis (list) Z (list))
(setq ss2 (ssget "X" '((0 . "POINT") )) )
(while (< i (sslength ss))
(setq p (cdr(assoc 10 (entget (ssname ss i)))))
(setq lis (append lis
(list (list (round (car p) 3) (round (cadr p) 3)) )
)
)
(setq Z (append Z (list (caddr p)))
)
(setq i (1+ i))
)
(while (< j (sslength ss2))
(setq ent (ssname ss2 j))
(setq p2 (cdr(assoc 10 (entget ent))))
(setq pkt (list (round (car p2) 3) (round (cadr p2) 3)) )
(if (setq L (member pkt lis))
(progn
(setq caoZ (nth (- (length lis) (length L)) Z) )
(command "move" ent "" '(0 0 0)
(list 0 0 caoZ)
)
)
)
(setq j (1+ j))
)
)
;
(defun round(so tp)
(setvar "dimzin" 0)
(atof (rtos so 2 tp))
)

Cám ơn tue_NV nhiều lắm, đúng là cực nhanh, trúng ý mình rồi. Tue_NV có thể chỉnh sửa lại một chút để tiện cho người sử dụng thao tác, đề phòng trường hợp một point có hai text số khác nhau mà trong đó có một text không phải là giá trị độ cao. Cách thao tác như sau:
nhập lệnh->yêu cầu chọn lớp chứa các point bằng cách chọn một point trên bản vẽ-> yêu cầu chọn lớp chứa các text độ cao bằng cách chọn một text độ cao -> enter
Một lần nữa cám ơn tue_NV nhiều
  • 0

#457 thiep

thiep

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 369 Bài viết
Điểm đánh giá: 260 (khá)

Đã gửi 04 December 2009 - 12:30 PM

Cám ơn tue_NV nhiều lắm, đúng là cực nhanh, trúng ý mình rồi. Tue_NV có thể chỉnh sửa lại một chút để tiện cho người sử dụng thao tác, đề phòng trường hợp một point có hai text số khác nhau mà trong đó có một text không phải là giá trị độ cao. Cách thao tác như sau:
nhập lệnh->yêu cầu chọn lớp chứa các point bằng cách chọn một point trên bản vẽ-> yêu cầu chọn lớp chứa các text độ cao bằng cách chọn một text độ cao -> enter
Một lần nữa cám ơn tue_NV nhiều

Chào Tue và tnmtp,
1. Rất may là bản vẽ cogopoint1 của tnmtp có các tọa độ điểm chèn text trùng với tọa độ điểm chèn point (theo thành phần X và Y) nên lisp của Tue chạy đúng. Còn tọa độ điểm chèn text không trùng với tọa độ điểm chèn point (theo thành phần X và Y) thì lisp chạy sai ngay. Đây là trường hợp rất thường gặp, khi các bác trắc đạc dời text cao độ vì chúng nó đôi khi hay nằm gần kề nhau (dời ra cho thoáng ấy mà).
2. Ngoài ra, còn 2 trường hợp khác cũng không đúng sau khi dùng lisp MPT như sau:
- Nếu có point nào có cao độ khác 0.
- Nếu có text cao độ nào có cao độ Z khác với chữ số của chính nó, (ví dụ đối tượng text 15.10 có cao độ Z là 0.0)
Mong Tue_NV hoàn thiện thêm lisp nhé. Trân trọng!
  • 1

#458 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3804 (đỉnh cao)

Đã gửi 04 December 2009 - 02:07 PM

Chào Tue và tnmtp,
1. Rất may là bản vẽ cogopoint1 của tnmtp có các tọa độ điểm chèn text trùng với tọa độ điểm chèn point (theo thành phần X và Y) nên lisp của Tue chạy đúng. Còn tọa độ điểm chèn text không trùng với tọa độ điểm chèn point (theo thành phần X và Y) thì lisp chạy sai ngay. Đây là trường hợp rất thường gặp, khi các bác trắc đạc dời text cao độ vì chúng nó đôi khi hay nằm gần kề nhau (dời ra cho thoáng ấy mà).
2. Ngoài ra, còn 2 trường hợp khác cũng không đúng sau khi dùng lisp MPT như sau:
- Nếu có point nào có cao độ khác 0.
- Nếu có text cao độ nào có cao độ Z khác với chữ số của chính nó, (ví dụ đối tượng text 15.10 có cao độ Z là 0.0)
Mong Tue_NV hoàn thiện thêm lisp nhé. Trân trọng!

Rất cảm ơn bạn thiep đã góp ý
1. Tue_NV hoàn toàn đồng ý với điểm 1 mà thiep đã nêu. Và mình nghĩ rằng nếu để Lisp chạy đúng thì khoảng cách toạ độ điểm chèn Text và toạ độ điểm chèn point (theo phương X và phương Y) phải nhỏ hơn 1 số e do User định trước. Nếu không thì Lisp sẽ chạy không đúng vì bản vẽ của ta có rất nhiều Text và point). Mình sẽ chỉnh lại chổ này nếu các bạn đồng ý theo quan điểm này

"2. Ngoài ra, còn 2 trường hợp khác cũng không đúng sau khi dùng lisp MPT như sau:
- Nếu có point nào có cao độ khác 0.
"
-> Cái này đồng ý với Thiep luôn. Tue_NV sẽ viết lại chổ này.

- Nếu có text cao độ nào có cao độ Z khác với chữ số của chính nó, (ví dụ đối tượng text 15.10 có cao độ Z là 0.0) : Tue_NV kiểm tra thấy Text 15.10 trong bản vẽ mà bạn tnmtpc gửi thì Text 15.10 có toạ độ điểm chèn của nó Z=15.10 chứ không phải là Z=0.00

Lisp của Tue_NV viết theo ý là toạ độ X,Y của point trùng với toạ độ X,Y của Text và move point có toạ độ Z=0 về toạ độ điểm chèn của Text, chứ không phải move về Z= chữ số của TEXT

-> Nay mình xin hoàn thành Lisp lại theo ý : toạ độ X,Y của point gần trùng với toạ độ X,Y của Text (khoảng chênh lệch = e) và move point có toạ độ Z=0 về toạ độ điểm chèn của Text

@ tnmtp : Bạn có thể nói rõ ý này của bạn được không? "Tue_NV có thể chỉnh sửa lại một chút để tiện cho người sử dụng thao tác, đề phòng trường hợp một point có hai text số khác nhau mà trong đó có một text không phải là giá trị độ cao."
Bạn có thể gửi file .dwg minh hoạ để dễ hiểu nhé.

Chào các bạn. Chúc vui vẻ.
  • 0

#459 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 04 December 2009 - 02:35 PM

Chào Tue và tnmtp,
1. Rất may là bản vẽ cogopoint1 của tnmtp có các tọa độ điểm chèn text trùng với tọa độ điểm chèn point (theo thành phần X và Y) nên lisp của Tue chạy đúng. Còn tọa độ điểm chèn text không trùng với tọa độ điểm chèn point (theo thành phần X và Y) thì lisp chạy sai ngay. Đây là trường hợp rất thường gặp, khi các bác trắc đạc dời text cao độ vì chúng nó đôi khi hay nằm gần kề nhau (dời ra cho thoáng ấy mà).
2. Ngoài ra, còn 2 trường hợp khác cũng không đúng sau khi dùng lisp MPT như sau:
- Nếu có point nào có cao độ khác 0.
- Nếu có text cao độ nào có cao độ Z khác với chữ số của chính nó, (ví dụ đối tượng text 15.10 có cao độ Z là 0.0)
Mong Tue_NV hoàn thiện thêm lisp nhé. Trân trọng!

Chào thiep
1. tọa độ điểm chèn text không trùng với tọa độ điểm chèn point
Đây là trường hợp rất thường gặp, khi các bác trắc đạc dời text cao độ vì chúng nó đôi khi hay nằm gần kề nhau (dời ra cho thoáng ấy mà).
-> t/hợp này rất khó xử lý vì khi đó xung quanh điểm chèn point có thể sẽ có 2 Text trở lên. Dựa trên cơ sở nào để quyết định (filter) Text nào là đúng.
Cách khắc phục nói chung là : các bác muốn thoáng thì chờ chạy LISP xong rồi hãy dời text cao độ.

2. Nếu có text cao độ nào có cao độ Z khác với chữ số của chính nó, (ví dụ đối tượng text 15.10 có cao độ Z là 0.0)
-> t/hợp này đuợc chia thành 2 nhánh : cập nhật theo cao độ TEXT hoặc cập nhật theo chữ số TEXT

Đây là Lisp cập nhật tọa độ điểm chèn point theo cao độ TEXT
(defun c:MPT(/ ds ent i insPt lay_Point lay_Txt lstPt lstZ lst_Point pt ss z)
(if
(and
(setq ent (car (entsel "\nChon Point de lay Layer chua POINT : ")))
(if (= (cdr (assoc 0 (entget ent))) "POINT")
(setq lay_Point (cdr(assoc 8 (entget ent))))
(setq lay_Point "*" ))
(princ (strcat "==> Layer Point = "lay_Point))
(setq ent (car (entsel "\nChon Text de lay Layer chua TEXT : ")))
(if (= (cdr (assoc 0 (entget ent))) "TEXT")
(setq lay_Txt (cdr(assoc 8 (entget ent))))
(setq lay_Txt "*"))
(princ (strcat "==> Layer Text = "lay_Txt))
(princ "\n\t\t Chon doi tuong ... ")
(setq ss (ssget (list (cons 0 "POINT,TEXT") (cons 8 (strcat lay_Point","lay_Txt))))
i -1)
)
(progn
(repeat (sslength ss)
(setq ent (ssname ss (setq i (1+ i)) ))
(if (= (cdr (assoc 0 (entget ent))) "POINT")
(setq lst_Point (cons ent lst_Point))
(progn
(setq insPt (cdr(assoc 10 (entget ent))))
(setq lstPt (append lstPt (list (list (car insPt) (cadr insPt)) ) ) )
(setq lstZ (append lstZ (list (caddr insPt))))
)
)
)
(foreach ent lst_Point
(setq ds (entget ent)
pt (cdr(assoc 10 ds))
pt (list (car pt)(cadr pt)) )
(if (setq i (vl-position pt lstPt))
(progn
(setq z (nth i lstZ) )
(setq ds (subst (cons 10 (append pt (list z))) (assoc 10 ds) ds))
(entmod ds)
)
)
)
)
)
(princ)
)

  • 1

#460 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1431 Bài viết
Điểm đánh giá: 1425 (rất tốt)

Đã gửi 04 December 2009 - 03:15 PM

Cám ơn tue_NV nhiều lắm, đúng là cực nhanh, trúng ý mình rồi. Tue_NV có thể chỉnh sửa lại một chút để tiện cho người sử dụng thao tác, đề phòng trường hợp một point có hai text số khác nhau mà trong đó có một text không phải là giá trị độ cao.
Cách thao tác như sau:
nhập lệnh->yêu cầu chọn lớp chứa các point bằng cách chọn một point trên bản vẽ-> yêu cầu chọn lớp chứa các text độ cao bằng cách chọn một text độ cao -> enter
Một lần nữa cám ơn tue_NV nhiều

LISP của Tue_NV đã xét đến t/hợp này khi lọc Layer : (ssget "X" '((0 . "TEXT") (8 . "el")))
cụ thể layer của TEXT là "el".
  • 0