Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
Doan Van Ha

[Đã xong] Lisp xác định nhanh màu sắc đối tượng để đặt nét in.

Các bài được khuyến nghị

Doan Van Ha    2.678

Xuất phát từ nhu cầu in ấn, cần phải xác định chỉ số màu của từng đối tượng để đặt nét in, tôi viết lisp này để phục vụ forum. Ai có nhu cầu thì down về dùng.

Ưu điểm của lisp này là xác định rất nhanh chỉ số màu của các đối tượng con: di mouse tới đâu thì hiện lên tới đó.

Nhược điểm: có một số hạn chế chưa khắc phục được + đang chờ mọi người test và góp ý.


;Doan Van Ha - CADViet.com - Ngay 08/05/2014.
;Chuc nang: Xac dinh nhanh mau sac cua doi tuong bang cach di chuyen chuot tren man hinh.
(defun C:HA( / rad gr code pt ent1 ent2 col)
 (vl-load-com)
 (setq rad (/ (* (getvar "Viewsize") (getvar "Pickbox")) (cadr (getvar "Screensize")))
       ent2 (entmakex (list (cons 0 "Point") (cons 10 '(0 0)))))
 (princ "\nDi chuy\U+1EC3n Mouse \U+0111\U+1EBFn t\U+1EEBng \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+1EC3 xem m\U+00E0u...")
 (while (and (setq gr (grread 't 15 1) code (car gr) pt (cadr gr)) (/= code 3) (/= code 25) (not (equal gr '(2 13))))
  (redraw) (entdel ent2)
  (Draw_Grvecs pt rad 3)
  (if (setq ent1 (car (nentselp pt)))
   (setq ent2 (MakeMtext (strcat "Color  " (itoa (setq col (Get_Color ent1)))) (polar pt (/ pi -4) (* 3 rad)) col))
   (setq ent2 (MakeMtext "Object ?" (polar pt (/ pi -4) (* 3 rad)) 1))))
 (redraw) (entdel ent2) (princ))
(defun *error* (msg)
 (redraw)
 (if ent2 (entdel ent2))
 (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
 (princ))
(defun Get_Color (ent / col)
 (setq col (vla-get-ColorIndex (vla-get-TrueColor (vlax-ename->vla-object ent))))
 (cond
  ((= col 256) (setq col (Get_Color_Layer (cdr (assoc 8 (entget ent))))))
  ((= col 0)
   (if (setq ss (Select_SS pt rad))
    (if (= (cdr (assoc 0 (setq elst (entget (ssname ss 0))))) "DIMENSION")
     (if (not (setq col (cdr (assoc 62 elst))))
 (setq col (Get_Color_Layer (cdr (assoc 8 elst)))))))))
 col)
(defun Select_SS(pt rad / p0 p1 p2 p3)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)))
 (ssget "c" p1 p3))
(defun Get_Color_Layer(name)
 (cdr (assoc 62 (entget (Tblobjname "Layer" name)))))
(defun Draw_Grvecs(pt rad col / p0 p1 p2 p3 p4)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)) p4 (polar p3 (/ pi -2) (* 2 rad)))
 (grvecs (list col p1 p2 p2 p3 p3 p4 p4 p1)))
(defun MakeMtext(txt pt col) 
 (entmakex (list (cons 0 "Mtext") (cons 100 "AcDbEntity") (cons 100 "AcDbMText")
   (cons 8 "0") (cons 1 (_Text txt)) (cons 10 pt) (cons 40 (/ (getvar 'Viewsize) 40)) (cons 62 col) (cons 71 1) (cons 90 3) (cons 63 256) (cons 45 1.5))))
(defun _Text (txt)
 (strcat "{\\fTimes New Roman|b1|i0|c0|p34;" txt "}")) ;(strcat "{\\fArial|b1|i0|c0|p34;" txt "}"))
 

  • Vote tăng 1

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
phamthanhbinh    3.123

Xuất phát từ nhu cầu in ấn, cần phải xác định chỉ số màu của từng đối tượng để đặt nét in, tôi viết lisp này để phục vụ forum. Ai có nhu cầu thì down về dùng.

Ưu điểm của lisp này là xác định rất nhanh chỉ số màu của các đối tượng con: di mouse tới đâu thì hiện lên tới đó.

Nhược điểm: có một số hạn chế chưa khắc phục được + đang chờ mọi người test và góp ý.

;Doan Van Ha - CADViet.com - Ngay 08/05/2014.
;Chuc nang: Xac dinh nhanh mau sac cua doi tuong bang cach di chuyen chuot tren man hinh.
(defun C:HA( / rad gr code pt ent1 ent2 col)
 (vl-load-com)
 (setq rad (/ (* (getvar "Viewsize") (getvar "Pickbox")) (cadr (getvar "Screensize")))
       ent2 (entmakex (list (cons 0 "Point") (cons 10 '(0 0)))))
 (princ "\nDi chuy\U+1EC3n Mouse \U+0111\U+1EBFn t\U+1EEBng \U+0111\U+1ED1i t\U+01B0\U+1EE3ng \U+0111\U+1EC3 xem m\U+00E0u...")
 (while (and (setq gr (grread 't 15 1) code (car gr) pt (cadr gr)) (/= code 3) (/= code 25) (not (equal gr '(2 13))))
  (redraw) (entdel ent2)
  (Draw_Grvecs pt rad 3)
  (if (setq ent1 (car (nentselp pt)))
   (setq ent2 (MakeMtext (strcat "Color  " (itoa (setq col (Get_Color ent1)))) (polar pt (/ pi -4) (* 3 rad)) col))
   (setq ent2 (MakeMtext "Object ?" (polar pt (/ pi -4) (* 3 rad)) 1))))
 (redraw) (entdel ent2) (princ))
(defun *error* (msg)
 (redraw)
 (if ent2 (entdel ent2))
 (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")))
 (princ))
(defun Get_Color (ent / col)
 (setq col (vla-get-ColorIndex (vla-get-TrueColor (vlax-ename->vla-object ent))))
 (cond
  ((= col 256) (setq col (Get_Color_Layer (cdr (assoc 8 (entget ent))))))
  ((= col 0)
   (if (setq ss (Select_SS pt rad))
    (if (= (cdr (assoc 0 (setq elst (entget (ssname ss 0))))) "DIMENSION")
     (if (not (setq col (cdr (assoc 62 elst))))
 (setq col (Get_Color_Layer (cdr (assoc 8 elst)))))))))
 col)
(defun Select_SS(pt rad / p0 p1 p2 p3)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)))
 (ssget "c" p1 p3))
(defun Get_Color_Layer(name)
 (cdr (assoc 62 (entget (Tblobjname "Layer" name)))))
(defun Draw_Grvecs(pt rad col / p0 p1 p2 p3 p4)
 (setq p0 (polar pt (/ pi -2) rad) p1 (polar p0 0 rad) p2 (polar p1 (/ pi 2) (* 2 rad)) p3 (polar p2 (/ pi -1) (* 2 rad)) p4 (polar p3 (/ pi -2) (* 2 rad)))
 (grvecs (list col p1 p2 p2 p3 p3 p4 p4 p1)))
(defun MakeMtext(txt pt col) 
 (entmakex (list (cons 0 "Mtext") (cons 100 "AcDbEntity") (cons 100 "AcDbMText")
   (cons 8 "0") (cons 1 (_Text txt)) (cons 10 pt) (cons 40 (/ (getvar 'Viewsize) 40)) (cons 62 col) (cons 71 1) (cons 90 3) (cons 63 256) (cons 45 1.5))))
(defun _Text (txt)
 (strcat "{\\fTimes New Roman|b1|i0|c0|p34;" txt "}")) ;(strcat "{\\fArial|b1|i0|c0|p34;" txt "}"))
 

Hề hề hề,

Thanh bác DoanVanHa về lisp xác định màu này.

Sau khi test thử mình thấy có một vài ý kiến như sau:

1/- Mình xài CAD2004 nên khi xài lisp thì việc di chuột trên màn hình bị giật cục chứ không mịn màng như trước và rất khó chọn trúng đối tượng cần xác định. 

2/- Vị trí đối tượng được chọn (cái ô màu xanh lá) chỉ hiển thị sau khi có hiển thị màu của đối tượng và do đó nếu chọn nhầm thì chỉ có nước .... chọn lại.

3/- Thời gian để xác định màu của một đối tượng chưa .....nhanh lắm bởi với CAD2004 của mình thì mất khoảng > 3 giây, và không có việc lưu lại kết quả này,(chỉ hiển thị xong rồi lại biến mất khi chuột di chuyển. Như vậy với cái trí nhớ cà lăm của mình thì đôi khi chọn được rồi lại phải chọn lại.

 

Rất mong bác nếu có thể sẽ hoàn thiện thêm để lisp có ứng dụng thuận tiện hơn.

Chúc bác khỏe và vui.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×