Đến nội dung


Hình ảnh
- - - - -

[nhờ viết lisp] đổi màu block reference và file xref


  • Please log in to reply
10 replies to this topic

#1 phuongtran613

phuongtran613

    biết zoom

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

Đã gửi 30 January 2012 - 03:50 PM

Nhờ các cao thủ viết dùm em lisp có thể đổi màu của block reference / file xref: có thể đổi màu toàn bộ block reference / file xref hoặc là chọn cái nào thì đổi màu cái đó.
Cám ơn
  • 0

#2 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 January 2012 - 04:24 PM

Nhờ các cao thủ viết dùm em lisp có thể đổi màu của block reference / file xref: có thể đổi màu toàn bộ block reference / file xref hoặc là chọn cái nào thì đổi màu cái đó.
Cám ơn

Hề hề hề,
Hãy post bản vẽ chứa các đối tượng cần đổi màu của bạn lên và nói cho rõ là đổi màu như thế nào nghen. gì chứ mấy thằng này nó chứa hầm bà lằng xắng cấu các đồi tượng con bên trong nó. vậy bạn muốn đổi tất cả các đối tượng này về cùng một màu hay là mỗi thằng một màu cho nó ..... thêm lòe loẹt?????
Hề hề hề
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#3 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 106 (tàm tạm)

Đã gửi 30 January 2012 - 05:03 PM

Nhờ các cao thủ viết dùm em lisp có thể đổi màu của block reference / file xref: có thể đổi màu toàn bộ block reference / file xref hoặc là chọn cái nào thì đổi màu cái đó.
Cám ơn


Lisp sau có chức năng Đổi màu Block (Cái này mình tham khảo lisp từ đâu đó và thêm tí mắm tí muối thôi). Hi vọng đúng ý bạn
Hình đã gửi

(defun err-ubc (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setq *error* olderr)
(princ)
)
(DEFUN C:mbl (/ BLK CBL CBL2 C ACL ALY NLY NCL)
(setq olderr *error* *error* err-ubc)
(setq C (acad_colordlg 1))
(PROMPT "\n >Chon Blocks se thay doi mau: ")
(SETQ SS (SSGET '((0 . "INSERT"))))
(SETQ K 0)
(WHILE (< K (SSLENGTH SS))
(setq CBL (tblsearch "BLOCK" (CDR (ASSOC 2 (ENTGET (SETQ BLK (SSNAME SS K)))))))
(SETQ CBL2 (CDR (ASSOC -2 CBL)))
(WHILE (BOUNDP 'CBL2)
(SETQ EE (ENTGET CBL2))
(SETQ NCL (CONS 62 C))
(SETQ ACL (ASSOC 62 EE))
(IF (= ACL nil)
(SETQ NEWE (APPEND EE (LIST NCL)))
(SETQ NEWE (SUBST NCL ACL EE))
)
(ENTMOD NEWE)
(SETQ CBL2 (ENTNEXT CBL2))
)
(ENTUPD BLK)
(SETQ K (1+ K))
)
(setq *error* olderr)
)

  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#4 phuongtran613

phuongtran613

    biết zoom

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

Đã gửi 30 January 2012 - 05:47 PM

Cám ơn các Bác đã nhanh chóng hỗ trợ.
Ý em là như thế này: em có 1 bản vẽ đã có chèn nhiều block, file xref và cũng đã có vẽ một số đối tượng rồi. Em cần lisp có thể đổi màu toàn bộ (hoặc 1 vài) block reference/ file xref này (các đối tượng đã vẽ không bị đổi màu) trước khi em vẽ thêm các đối tượng khác (để đánh dấu nổi lên khi convert qua PDF,..). Mong các Bác giúp đỡ thêm.
Cám ơn
  • 0

#5 phuongtran613

phuongtran613

    biết zoom

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

Đã gửi 30 January 2012 - 06:00 PM


Lisp sau có chức năng Đổi màu Block (Cái này mình tham khảo lisp từ đâu đó và thêm tí mắm tí muối thôi). Hi vọng đúng ý bạn
Hình đã gửi


(defun err-ubc (s)
(if (/= s "Function cancelled")
(princ (strcat "\nError: " s))
)
(setq *error* olderr)
(princ)
)
(DEFUN C:mbl (/ BLK CBL CBL2 C ACL ALY NLY NCL)
(setq olderr *error* *error* err-ubc)
(setq C (acad_colordlg 1))
(PROMPT "\n >Chon Blocks se thay doi mau: ")
(SETQ SS (SSGET '((0 . "INSERT"))))
(SETQ K 0)
(WHILE (< K (SSLENGTH SS))
(setq CBL (tblsearch "BLOCK" (CDR (ASSOC 2 (ENTGET (SETQ BLK (SSNAME SS K)))))))
(SETQ CBL2 (CDR (ASSOC -2 CBL)))
(WHILE (BOUNDP 'CBL2)
(SETQ EE (ENTGET CBL2))
(SETQ NCL (CONS 62 C))
(SETQ ACL (ASSOC 62 EE))
(IF (= ACL nil)
(SETQ NEWE (APPEND EE (LIST NCL)))
(SETQ NEWE (SUBST NCL ACL EE))
)
(ENTMOD NEWE)
(SETQ CBL2 (ENTNEXT CBL2))
)
(ENTUPD BLK)
(SETQ K (1+ K))
)
(setq *error* olderr)
)


Bác cho em xin thêm các lisp như trong link này nha.
http://www.cadonline...der=asc&start=0
Cám ơn bác nhiều
  • 0

#6 hochoaivandot

hochoaivandot

    biết dimradius

  • Members
  • PipPipPipPipPip
  • 310 Bài viết
Điểm đánh giá: 106 (tàm tạm)

Đã gửi 31 January 2012 - 01:39 PM

Cái đó bạn chờ thêm vài hôm nữa nhé. Mình đang tạo file Setup. Vài hôm nữa bạn vào www.cadonline.duyxuyen.vn để tải
  • 0

Dương Bá Diệp

 

www.cadonline.duyxuyen.vn 

 

Thành viên nhóm CADMAGIC

 


#7 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 01 February 2012 - 10:21 AM

Cái đó bạn chờ thêm vài hôm nữa nhé. Mình đang tạo file Setup. Vài hôm nữa bạn vào www.cadonline.duyxuyen.vn để tải

Hề hề hề,
Bạn có thể cho xin file .lsp và .dcl của những ứng dụng này được không nhỉ??? Quả thật là mình cũng muốn mót tí ti từ mấy cái ông tây này, nhất là cái mảng tạo hộp thoại bạn ạ.
Xin chân thành cám ơn trước.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#8 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 01 February 2012 - 10:48 AM

Hề hề hề, Bạn có thể cho xin file .lsp và .dcl của những ứng dụng này được không nhỉ??? Quả thật là mình cũng muốn mót tí ti từ mấy cái ông tây này, nhất là cái mảng tạo hộp thoại bạn ạ. Xin chân thành cám ơn trước.

Bác PTB ơi! Cái này không tạo dialoge mà chỉ là dùng 1 dòng lệnh để lấy dialoge của Cad, đó là hàm bên dưới, nó trả về number của màu được chọn.
Thân thương!
(setq C (acad_colordlg 1))
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#9 phuongtran613

phuongtran613

    biết zoom

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

Đã gửi 10 February 2012 - 09:29 PM

Sao vẫn chưa download được hả bác?
  • 0

#10 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 10 February 2012 - 09:39 PM

Sao vẫn chưa download được hả bác?

Bạn vào trang #3, không trở ngại gì, tôi đã down thử, vẫn OK.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#11 mtacd

mtacd

    biết pan

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

Đã gửi 09 September 2012 - 06:06 PM

sao lips này lại không đổi được block reference hả bạn,bạn có thể hướng dẫn cụ thể chó mình được không?
  • 0