Đến nội dung


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

Viết Lisp theo yêu cầu


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

#1481 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 11 January 2009 - 05:37 PM

Trước tiên xin lỗi các bác vì bài viết này em đã post lên một topick khác giờ lại post lên đây, mong mấy bác thông cảm vì em nghĩ chắc bên kia chắc mấy bác không chú ý đến. ^_^
Chuyên là thế này: Hiện nay công việc của em hay phải thực hiện một công việc đơn giản nhưng cực tốn thời gian đó là gán cao độ cho các đường đồng mức. Vì vậy để tiết kiệm thời gian nên em mạnh dạn post lên đây mong được các bác giúp đỡ:
Bác nào có thể giúp em cái lisp gán cao độ cho bình đồ như sau.

1/ Gõ lệnh VD: cc enter
2/ Nhập vào cao độ ban đầu enter
3/ nhập vào độ chênh cao giữa các đường dồng mức (có thể là một số âm hoặc dương VD: +1 hơặc -1) enter
4/ Cuối cùng pick chuột lên các đường đồng mức cần gán cao độ và nó sẽ tự động gán vào cao độ cho đường đồng mức này (Cao độ được gán có trị số được tính theo hình thức công dồn VD: cao đọ xuất phát ban đầu là 100 với chênh cao là 1 thì đường đồng mức được pick đầu tiện là 101, đường dc pick tiếp theo là 102......).
5/ Việc gán cao độ đuợc khống chế sao cho an toàn vì cái này liên quan đến Khối lượng công trình rất lớn (Chỉ tác động đến Elevation của đường ĐM mà thôi mọi thuộc tinh khác sẽ đựoc giữ lại)
6/ Sau khi gán cao độ đường được gán sẽ được chuyển về một layer mới VD: DM da so hoa.
http://www.cadviet.c...untitled_54.bmp
Mong các bác giúp đỡ :D

(defun C:CC ()

(setq cdo (getreal "\n Nhap cao do ban dau: ")
ccao (getreal "\n Nhap chenh cao giua cac duong dong muc: ")
next (strcat "dau tien (cao do la: " (rtos cdo 2 2) ")")
dem 0
)
(while (setq pline (entsel (strcat "\n Chon duong dong muc " next)))
(if (or (= (cdr (assoc 0 (entget (car pline)))) "POLYLINE")
(= (cdr (assoc 0 (entget (car pline)))) "LWPOLYLINE")
)
(progn
(entmod (subst (cons 38 cdo) (assoc 38 (entget (car pline))) (entget (car pline))))
(setq dem (1+ dem)
cdo (+ cdo ccao)
next (strcat "thu " (itoa (1+ dem)) " (cao do la: " (rtos cdo 2 2) ") /An enter de ket thuc chon/"))
)
(alert "Chon lai!!! . Doi tuong ban vua chon khong phai la Polyline")
)
)
)
  • 0

#1482 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 11 January 2009 - 05:46 PM

sửa lại tý chút ( do quên không đọc yêu cầu cuối cùng của bạn ^_^ )

(defun C:CC (/ cdo ccao next dem pline)

(setq cdo (getreal "\n Nhap cao do ban dau:")
ccao (getreal "\n Nhap chenh cao giua cac duong dong muc:")
next (strcat "dau tien (cao do la: " (rtos cdo 2 2) ")")
dem 0
)
(while (setq pline (entsel (strcat "\n Chon duong dong muc " next)))
(if (or (= (cdr (assoc 0 (entget (car pline)))) "POLYLINE")
(= (cdr (assoc 0 (entget (car pline)))) "LWPOLYLINE")
)
(progn
(entmod (subst (cons 38 cdo) (assoc 38 (entget (car pline))) (entget (car pline))))
(entmod (subst (cons 8 "DM so hoa") (assoc 8 (entget (car pline))) (entget (car pline))))
(setq dem (1+ dem)
cdo (+ cdo ccao)
next (strcat "thu " (itoa dem) " (cao do la: " (rtos cdo 2 2) ") /An enter de ket thuc chon/"))
)
(alert "Chon lai!!! . Doi tuong ban vua chon khong phai la Polyline")
)
)
)

  • 0

#1483 xuantran15

xuantran15

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 295 Bài viết
Điểm đánh giá: 112 (tàm tạm)

Đã gửi 11 January 2009 - 09:56 PM

Cám ơn nataca nhiều lắm nhưng mình vẫn chưa dùng được cái lisp này ^_^
Khi gõ cc enter thì nó báo lỗi như sau.


Command: cc *Cancel*
too many arguments

mong nataca xem lai giúp mình với nhé. Cám ơn nhiều :D
  • 0
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#1484 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 11 January 2009 - 10:02 PM

Cám ơn nataca nhiều lắm nhưng mình vẫn chưa dùng được cái lisp này :D
Khi gõ cc enter thì nó báo lỗi như sau.
Command: cc *Cancel*
too many arguments

mong nataca xem lai giúp mình với nhé. Cám ơn nhiều :D

Xin lỗi bạn. Lỗi do mình bỏ mấy hàm con không cần thiết đi mà quên mất mấy cái rơi vãi chưa bỏ hết ^_^
Đã edit lại
  • 1

#1485 xuantran15

xuantran15

    biết lệnh ddedit

  • Members
  • PipPipPipPip
  • 295 Bài viết
Điểm đánh giá: 112 (tàm tạm)

Đã gửi 11 January 2009 - 10:44 PM

Cám ơn bác nhiều``````````` lắm. ước gì bác có ở đây để ôm bác thắm thiết một cái :D heeee. Chúc bác sắp tới đón tết vui vẻ tấn tài tấn lộc, hạnh phúc tràn trề và được thưởng tết thật nhiều. heeee ^_^ lần nữa cám ơn bác nhé!
  • 1
Hình đã gửi
Thu đi cho lá vàng bay
Lá rơi cho đám cưới về......

#1486 transu

transu

    biết vẽ spline

  • Members
  • PipPip
  • 93 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 12 January 2009 - 11:00 AM

bác nào biết địa chỉ imail của bác Hoành cho e xin
  • 0

#1487 phamthanhhungks

phamthanhhungks

    biết vẽ polygon

  • Members
  • PipPip
  • 74 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 12 January 2009 - 03:31 PM

Không biết vấn đề này đã được từng đưa ra trên diễn đàn của cad việt chưa? Nhưng em kiếm hoài mà không thấy có jì nếu đã từng nêu lên rồi aem đừng giận nha! ^_^
Chẳng là, bên em thường xuyên phải làm việc với những file mà bên chủ đầu tư chuyển về mà những file đó thì trời ơi quá trời rác trong đó luôn ( nào là Text Style, Layer, Dim,.... ) nhưng khó khăn nhất vẫn là các layer và text style đang nằm trong những block, để loại bỏ được các layer và text style đó quả thật là khó khăn... Vậy cách giải quyết vấn đề là aem có thể tạo ra 1 cái Lisp mà có thể đổi được: Layer, Text Style, Dim Style,... Đang nằm trong các block. Mà không cần phải đụng đến block hoặc Edit block được không? Cảm ơn anh em vì đã đọc qua, và giúp em giải quyết bài toán này. thank aem rất nhiều.
  • 0

#1488 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 12 January 2009 - 04:09 PM

Không biết vấn đề này đã được từng đưa ra trên diễn đàn của cad việt chưa? Nhưng em kiếm hoài mà không thấy có jì nếu đã từng nêu lên rồi aem đừng giận nha! ^_^
Chẳng là, bên em thường xuyên phải làm việc với những file mà bên chủ đầu tư chuyển về mà những file đó thì trời ơi quá trời rác trong đó luôn ( nào là Text Style, Layer, Dim,.... ) nhưng khó khăn nhất vẫn là các layer và text style đang nằm trong những block, để loại bỏ được các layer và text style đó quả thật là khó khăn... Vậy cách giải quyết vấn đề là aem có thể tạo ra 1 cái Lisp mà có thể đổi được: Layer, Text Style, Dim Style,... Đang nằm trong các block. Mà không cần phải đụng đến block hoặc Edit block được không? Cảm ơn anh em vì đã đọc qua, và giúp em giải quyết bài toán này. thank aem rất nhiều.

Có một câu trên diễn đàn này có khi sắp thành nhàm rồi: "bạn hãy up file mẫu lên".
  • 0

#1489 tnmtpc

tnmtpc

    biết dimcontinue

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

Đã gửi 12 January 2009 - 04:51 PM

sửa lại tý chút ( do quên không đọc yêu cầu cuối cùng của bạn ^_^ )


(defun C:CC (/ cdo ccao next dem pline)

(setq cdo (getreal "\n Nhap cao do ban dau:")
ccao (getreal "\n Nhap chenh cao giua cac duong dong muc:")
next (strcat "dau tien (cao do la: " (rtos cdo 2 2) ")")
dem 0
)
(while (setq pline (entsel (strcat "\n Chon duong dong muc " next)))
(if (or (= (cdr (assoc 0 (entget (car pline)))) "POLYLINE")
(= (cdr (assoc 0 (entget (car pline)))) "LWPOLYLINE")
)
(progn
(entmod (subst (cons 38 cdo) (assoc 38 (entget (car pline))) (entget (car pline))))
(entmod (subst (cons 8 "DM so hoa") (assoc 8 (entget (car pline))) (entget (car pline))))
(setq dem (1+ dem)
cdo (+ cdo ccao)
next (strcat "thu " (itoa dem) " (cao do la: " (rtos cdo 2 2) ") /An enter de ket thuc chon/"))
)
(alert "Chon lai!!! . Doi tuong ban vua chon khong phai la Polyline")
)
)
)

Mình dùng lisp này, kết quả chỉ thay đổi polyline sang layer DM sohoa, tất cả các cao độ của các polyline vẫn 0.00. Bạn xem lại giúp!
  • 0

#1490 phamthanhhungks

phamthanhhungks

    biết vẽ polygon

  • Members
  • PipPip
  • 74 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 12 January 2009 - 04:54 PM

cảm ơn sự nhiệt tình của các Nataca. Sau đây là một ví dụ trời một file mẫu cần chuyển layer và text style.
Hình đã gửi
và đây là file cad của nó có ji anh xem và tham khảo xử lí dùm mình vụ này nha (rút kinh nghiệm lần trước với bác Tuệ lần này em save file xuống cad 2000 roài, rất tiện với tất cả aem.) hjhj :D ^_^ Năm mới ....... cho pà kon tự viết tiếp
http://www.cadviet.com/upfiles/1_9.dwg
  • 0

#1491 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 12 January 2009 - 05:00 PM

Mình dùng lisp này, kết quả chỉ thay đổi polyline sang layer DM sohoa, tất cả các cao độ của các polyline vẫn 0.00. Bạn xem lại giúp!

Mình đã vẽ 1 số đường Polyline để test thử lại nhưng không vấn đề gì. Bạn có thể gửi lên file mà bạn làm được không?
  • 0

#1492 tnmtpc

tnmtpc

    biết dimcontinue

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

Đã gửi 12 January 2009 - 07:05 PM

Mình đã vẽ 1 số đường Polyline để test thử lại nhưng không vấn đề gì. Bạn có thể gửi lên file mà bạn làm được không?

Đây nè bạn, mình vẽ các polyline xong, load lisp, hoạt động bình thường nhưng kết quả như thế này
http://www.cadviet.c...es/ketqua_1.dwg
  • 0

#1493 loiphong

loiphong

    biết vẽ circle

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

Đã gửi 12 January 2009 - 07:58 PM

Bạn dùng lisp sau. Gõ lệnh DBS (Dim Bị Sửa!) -> toàn bộ các dim bị "độ chế" sẽ chuyển sang màu đỏ:

(defun C:DBS( / ss e txt)
(setq ss (ssget "X" '((0 . "DIMENSION"))))
(while (setq e (ssname ss 0))
(setq txt (cdr (assoc 1 (entget e))))
(if (not (or (= txt "") (vl-string-search "<>" txt)))
(command "change" e "" "p" "c" 1 "")
)
(ssdel e ss)
)
(princ)
)


Lưu ý
Các Dim "không bị sửa" và được gán Dim Scale Linear khác 1 vẫn được cho là hợp lệ. Nếu bạn có nhu cầu phát hiện luôn các "chú" này thì ssg sẽ bổ sung thêm.

Cám ơn ssg rất nhiều, Lisp chạy rất tốt.!
  • 0

#1494 nataca

nataca

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 712 Bài viết
Điểm đánh giá: 553 (tốt)

Đã gửi 12 January 2009 - 08:02 PM

Đây nè bạn, mình vẽ các polyline xong, load lisp, hoạt động bình thường nhưng kết quả như thế này
http://www.cadviet.c...es/ketqua_1.dwg

Do đối tượng của bạn là 2Dpolyline nên không được là đúng rồi. Cái này đã sửa lại một chút để làm việc được đối với đối tượng như "bản vẽ" bạn gửi.
http://www.mediafire.com/?eyzzjmayyny
  • 0

#1495 LXD

LXD

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 13 January 2009 - 09:32 AM

Chào các Pro. Nhờ các Bác giúp Em với. Em có 1 Layer gồm các đường Line, chỉ có 2 Vertext, điểm đầu và điểm cuối. Bây giờ Em muốn ve thêm 1 nét mũi tên ở 2 đầu của các đường Line đấy.
Mũi tên có kích thước theo chiều vuông góc là dài 2, rộng ra 1. Hiện tại Em đang phải làm bằng cách tạo Block Mũi tên, sau đó insert.
Em nghĩ là về thuật toán thì có thể viết được. Nhờ các bác giúp đỡ, làm sao để chon tất cả chứ không phải làm từng cái như thế này.
Các Bác tham khảo file: http://www.cadviet.c...les/Mui_ten.dwg
  • 0

#1496 phamthanhhungks

phamthanhhungks

    biết vẽ polygon

  • Members
  • PipPip
  • 74 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 13 January 2009 - 11:46 AM

cảm ơn sự nhiệt tình của các Nataca. Sau đây là một ví dụ trời một file mẫu cần chuyển layer và text style.
Hình đã gửi
và đây là file cad của nó có ji anh xem và tham khảo xử lí dùm mình vụ này nha (rút kinh nghiệm lần trước với bác Tuệ lần này em save file xuống cad 2000 roài, rất tiện với tất cả aem.) hjhj ^_^ :D Năm mới ....... cho pà kon tự viết tiếp
http://www.cadviet.com/upfiles/1_9.dwg

không ai trả lời cho bài toán của em với hả? Thức đêm trông trờ...
  • 0

#1497 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 13 January 2009 - 02:33 PM

Không biết vấn đề này đã được từng đưa ra trên diễn đàn của cad việt chưa? Nhưng em kiếm hoài mà không thấy có jì nếu đã từng nêu lên rồi aem đừng giận nha! ^_^
Chẳng là, bên em thường xuyên phải làm việc với những file mà bên chủ đầu tư chuyển về mà những file đó thì trời ơi quá trời rác trong đó luôn ( nào là Text Style, Layer, Dim,.... ) nhưng khó khăn nhất vẫn là các layer và text style đang nằm trong những block, để loại bỏ được các layer và text style đó quả thật là khó khăn... Vậy cách giải quyết vấn đề là aem có thể tạo ra 1 cái Lisp mà có thể đổi được: Layer, Text Style, Dim Style,... Đang nằm trong các block. Mà không cần phải đụng đến block hoặc Edit block được không? Cảm ơn anh em vì đã đọc qua, và giúp em giải quyết bài toán này. thank aem rất nhiều.

Chào bạn phamthanhhungks,
Yêu cầu của bạn thực khó hiểu. Bạn yêu cầu thay đổi các thuộc tính của một block nhưng lại không đụng đến hay không được edit block đó. Vậy là sao bạn hè? Hay là bạn muốn copy block đó ra chỗ khác để edit?
Khi bạn thay đổi bất cứ thuộc tính trẻ con nào của block tức là bạn đã edit cáica1iock ấy rồi bạn ạ.
Nếu ý bạn là dùng lisp để tự động thay đổi các thuộc tính này mà không phải làm bằng cách thủ công thì điều này hoàn toàn có thể bạn ạ.
Tuy nhiên bạn phải nói rõ yêu cầu thay đổi như thế nào thì mới có thể viết lisp được bạn ạ. Để giải bài toán thì phải có cái đích của nó chứ, phải không nào? Còn nói chung chung như bạn khó giải quá, hoặc giả kết quả giải ra chẳng phải cái bạn cần.
Nếu bạn đã có một cái lưng vốn kha khá về lisp thì mình xin nói vắn tắt hướng giải quyết như sau:
1/- Chọn tất cả các đối tượng là block trên bản vẽ dùng hàm (setq ss (ssget "X" (list (cons 0 "insert"))))
2/- Dùng hàm lặp qua tất cả các block trong bộ lựa chọn ss này để tìm cái thuộc tính mà bạn muốn thay đổi trong mỗi block. Có thể dùng hàm While hay foreach tùy bạn chọn.
Cần lưu ý là bạn phải nhập cái thuộc tính bạn cần lựa chọn là gì để lisp sẽ tự động kiểm tra, kiếm tìm trong bộ lựa chọn ss.
Cần tạo một bộ chọn mới để lưu các đối tượng được lựa chọn lại.
3/- Nhập giá trị mới cho các thuộc tính đã được nhặt ra
4/- Cập nhật các giá trị mới này cho các thuộc tính của block. Hàm (entmod ......)
5/- Cập nhật block mới . Hàm (entup ....)

Việc bạn muốn lựa chọn bao nhiêu thuộc tính cần thay đổi cũng được nhưng mỗi thuộc tính cần tạo một bộ chọn riêng để lưu sẽ thuận lợi hơn cho bạn khi thay đổi giá trị của nó và khi kiểm soát sự hoạt động của chương trình lisp.
Có thể thuộc tính bạn dùng để chọn lựa khác với thuộc tính cần thay đổi tùy theo yêu cầu của bạn. Ví dụ bạn chọn đối tượng theo thuộc tính lớp, nhưng lại thay đổi thuộc tính màu sắc của nó chẳng hạn,......

Rất mong bạn hoàn thành được yêu cầu của mình. Trong quá trình thực hiện, nếu ó vướng mắc gì hãy post lên để cùng trao đổi.
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.

#1498 ssg

ssg

    biết lệnh adcenter

  • Vip
  • PipPipPipPipPipPipPip
  • 1228 Bài viết
Điểm đánh giá: 1087 (rất tốt)

Đã gửi 13 January 2009 - 03:05 PM

Chào các Pro. Nhờ các Bác giúp Em với. Em có 1 Layer gồm các đường Line, chỉ có 2 Vertext, điểm đầu và điểm cuối. Bây giờ Em muốn ve thêm 1 nét mũi tên ở 2 đầu của các đường Line đấy.
Mũi tên có kích thước theo chiều vuông góc là dài 2, rộng ra 1. Hiện tại Em đang phải làm bằng cách tạo Block Mũi tên, sau đó insert.
Em nghĩ là về thuật toán thì có thể viết được. Nhờ các bác giúp đỡ, làm sao để chon tất cả chứ không phải làm từng cái như thế này.
Các Bác tham khảo file: http://www.cadviet.c...les/Mui_ten.dwg

Bạn thử lisp này xem. Lệnh MTE:


;;;-------------------------------------------------------------
(defun RTD(x) (/ (* x 180) pi) ) ;;;Change radian to degree
;;;-------------------------------------------------------------
(defun C:MTE( / ss e p1 p2 p3 p4)
(setq ss (ssget '((0 . "LINE"))))
(while (setq e (ssname ss 0))
(setq
p1 (cdr (assoc 10 (entget e)))
p2 (cdr (assoc 11 (entget e)))
p3 (polar p1 (angle p1 p2) (sqrt 5))
p4 (polar p2 (angle p2 p1) (sqrt 5))
)
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p3)))
(command "rotate" (entlast) "" p1 (rtd (atan 0.5)))
(entmake (list (cons 0 "LINE") (cons 10 p2) (cons 11 p4)))
(command "rotate" (entlast) "" p2 (rtd (atan 0.5)))
(ssdel e ss)
)
(princ)
)
;;;-------------------------------------------------------------

  • 0

#1499 LXD

LXD

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 11 (tàm tạm)

Đã gửi 13 January 2009 - 03:29 PM

Quá chuẩn luôn.
Cảm ơn Bác ssg nhiều lắm.
Em cũng đã thử học Lisp, nhưng nó nhiều ngoặc quá, đọc được 1 tý là buồn ngủ.
Thanks Bác!
  • 0

#1500 phamthanhhungks

phamthanhhungks

    biết vẽ polygon

  • Members
  • PipPip
  • 74 Bài viết
Điểm đánh giá: 19 (tàm tạm)

Đã gửi 13 January 2009 - 04:17 PM

Cảm ơn anh ThanhBinh vì sự nhiệt tình của anh trong câu hỏi của em, Chuyện là vậy nè hôm bữa em có qua cty mà thằng bạn em đang làm, thấy bọn nó có một lênh giống lênh MA nhưng mà nó có thể quét được các: Layer , text Style, Dim... trong block ( với sự hỗ trợ của lệnh Layiso để giữ các layer ) Mà hổng cần có đụng chạm gì vào block hết trơn. Nhưng mà xin cái lisp đó thì bên đó không cho nên viết lên đây mong aem nào cao có nhều kinh nghiệm về LISP giải quyết dùm, giúp đỡ anh em đỡ tốn trong vấn đề quản lí layer, Text style, dim.... trong một bản vẽ. Thak aem rất nhiều. :wub: :wub: :wub: :D ^_^ :D :D :D ^_^ :D :D :D :D :D
  • 0