Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
quochuyksxd

[Yêu cầu] Cần lisp kiểm tra dim bị edit

Bởi quochuyksxd , trong AutoLisp

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

quochuyksxd    25

quochuyksxd
Đã đăng

Kính gửi các bác tiền bối về lisp trong diễn đàn, hiện nay em thấy có nhiều bản vẽ bị edit dim quá nhiều, về mặt hình thức thì không sao nhưng về mặt tương đối hình học thì chưa hợp lý lắm. Việc hiệu chỉnh cũng dễ bị nhầm lẫn (chẳng hạn khi stretch thì kích thước vẫn không đổi). Vì vậy em mong muốn các bác viết 1 lisp để có thể thực hiện việc kiểm tra các dim bị edit kích thước với quy trình như sau:

-Lệnh KTD (hoặc gì đó do các bác đặt)

-Quét toàn bộ bản vẽ cần kiểm tra (có thể quét toàn bộ đối tượng hoặc chỉ yêu cầu quét đối tượng dim, cái này cũng do các bác viết)

-Enter

-Nếu Dim nào bị edit kích thước, lisp sẽ tự động lọc riêng thành 1 layer đồng thời đổi màu theo layer thì càng tốt (tên layer này do các bác lập trình đặt, ví dụ: dimed, layer này các bác nên thiết lập màu sắc lạ tránh trùng với màu dim thông thường hay đặt như màu 8, 253,..để dễ phân biệt chỉnh sửa và chuyển về layer dim chung)

Rất cảm ơn các bác!

 

  • Vote tăng 1
  • Vote giảm 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

nhoclangbat    392

nhoclangbat
Đã đăng

- hi ^^, nhoc mới viết sơ bộ bạn test thử xem ^^, bạn có thể quét hết bản vẽ nó chỉ nhận đối tượng là dim, cái nào bị edit nó sẽ chuyển sang màu đỏ, layer dimed.

- nếu bạn thấy ok bạn mún thêm mắm múi cho ngon thì bạn trình bày cụ thể , đưa bản vẽ lun càng tốt, chỉnh sữa sẽ sát theo y/c của bạn ^^

(defun c:ktd (/ ss info dxf1 ename)
(prompt "Quet chon cac dim can kiem tra")
(if (setq ss (ssget '((0 .  "DIMENSION"))))
(progn 
 (repeat (sslength ss)
 (setq ename (ssname ss 0))
 (setq info (entget ename))
 (setq dxf1 (cdr (assoc 1 info)))
 (if (/= dxf1 "")
   (entmod (append info (list (cons 62 1) (cons 8 "dimed")) ))
   )
   (ssdel ename ss)
   )
  )
 )
 )

-P/s: có thể phần y/c thêm nhoc ko chỉnh nỗi , bạn thông cảm đợi các anh khác trợ giúp  :P

  • Vote tăng 2

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

quochuyksxd    25

quochuyksxd
Đã đăng

Cảm ơn bác @nhoclangbat. Lisp của bác cơ bản đã thực hiện đúng ý tưởng của em rồi, tuy nhiên có 1 vấn đề là bác đã tách được dim bị edit rồi và bác đã lập cho nó chuyển sang màu đỏ nhưng thực tế khi mình đã set màu cố định trong dim rồi thì sau khi thực hiện lệnh dim bị edit vẫn không nhảy màu. Vấn đề này em nghĩ cũng khó, bởi vì nếu mình tách hẳn thành 1 dim mới thì được. em gửi cho bác 1 bản vẽ e sẽ edit 1 vài dim để bác thử kiểm nghiệm lisp xem sao  :mellow:

http://www.cadviet.com/upfiles/4/100618_vd.dwg

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

pphung183    428

pphung183
Đã đăng

Thử xem :)

(defun C:KTD( / ss ena txt n kq) 
 (setq ss (ssget "X" '((0 . "DIMENSION"))))
(setq n 0)
(if (not (tblsearch "layer" "Dimed"))
  (vl-cmdf "Layer" "N" "Dimed" "C" "1" "Dimed" "")
)
(while (setq ena (ssname ss 0))
  (setq txt (cdr (assoc 1 (entget ena))))
  (if (not (or (= txt "") (vl-string-search "<>" txt))) (progn
    (vl-cmdf "change" ena "" "p" "LA" "Dimed" "")
(vl-cmdf "._DIMOVERRIDE" "dimclrt" 1 "" ena "" )
    (setq n (1+ n))
  ))
  (ssdel ena ss)
)
(if (= n 0) (setq kq "Ket qua check: OK")
  (setq kq (strcat "Co " (itoa n) " Dimensions bi sua Text"
           "\nda duoc chuyen sang layer Dimed co mau 1!")
  )
)
(alert kq)
(princ))

Test bản vẽ bạn đâu thấy dim nào thay đổi text override <_<

  • Vote tăng 3

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

nhoclangbat    392

nhoclangbat
Đã đăng

- oh có anh Phung tham gia ^^, nhoc cũng mới sữa xong ^^, bạn xem sao



(defun c:ktd (/ ss info dxf1 ename obj)
(vl-load-com)
(if (null (tblsearch "layer" "dimed")) (K:layer "dimed" 1))
(prompt "Quet chon cac dim can kiem tra")
(if (setq ss (ssget '((0 .  "DIMENSION"))))
(progn 
 (repeat (sslength ss)
 (setq ename (ssname ss 0))
 (setq obj (vlax-ename->vla-object ename))
 (setq info (entget ename))
 (setq dxf1 (cdr (assoc 1 info)))
  (if (/= dxf1 "")
   (progn
     ;(entmod (subst (cons 1 "") (assoc 1 info) info))
	(vla-put-DimensionLinecolor obj "1")
	 (vla-put-TextColor obj "1")
	 (vla-put-ExtensionLinecolor obj "1")
	 (vla-put-layer obj "dimed")
    )
   )
   
   (ssdel ename ss)
   )
  )
 )
 (princ)
 )
(defun K:layer (ten clr)
(if (null (tblsearch "LAYER" ten))
(entmakex (list 
               '(0 . "LAYER")
               '(100 . "AcDbSymbolTableRecord")
               '(100 . "AcDbLayerTableRecord")
			   '(70 . 0)
                (cons 2 ten)
                (cons 62 clr))
)
)
) 

 

-p/s: sau khi nhận thấy các dim bị edit , đổi layer chuyển màu, nó sẽ edit lun về kích thước thật của dim

  • Vote tăng 2

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

hiepttr    538

hiepttr
Đã đăng

Nhoc:

Chỉ cần đánh dấu những dim đã ed, ko cần sửa, Vì có nhiều BV cần ed kích thước, nếu chạy xong lisp này sẽ bị nhảy lung tung.

Cũng vì thế mà cad cho ed dim mà :D

  • Vote tăng 2

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

Hoan1111    695

Hoan1111
Đã đăng

:D :D :D

Câu hỏi hay

:D :D :D

 

Cũng chẳng hay ho gì lắm vì làm thủ công cũng biết được có bao nhiêu kích thước đã bị edit,  đỡ phải hao tổn nowtron nhớ tên lisp! :) :) :)

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

quochuyksxd    25

quochuyksxd
Đã đăng

Thử xem :)

(defun C:KTD( / ss ena txt n kq) 
 (setq ss (ssget "X" '((0 . "DIMENSION"))))
(setq n 0)
(if (not (tblsearch "layer" "Dimed"))
  (vl-cmdf "Layer" "N" "Dimed" "C" "1" "Dimed" "")
)
(while (setq ena (ssname ss 0))
  (setq txt (cdr (assoc 1 (entget ena))))
  (if (not (or (= txt "") (vl-string-search "<>" txt))) (progn
    (vl-cmdf "change" ena "" "p" "LA" "Dimed" "")
(vl-cmdf "._DIMOVERRIDE" "dimclrt" 1 "" ena "" )
    (setq n (1+ n))
  ))
  (ssdel ena ss)
)
(if (= n 0) (setq kq "Ket qua check: OK")
  (setq kq (strcat "Co " (itoa n) " Dimensions bi sua Text"
           "\nda duoc chuyen sang layer Dimed co mau 1!")
  )
)
(alert kq)
(princ))

Test bản vẽ bạn đâu thấy dim nào thay đổi text override <_<

Chuẩn rồi bác Nhoclangbat. Cảm ơn bác nhiều nhé. Nể mấy bác "cao thủ" làm thủ công vẫn tìm hết dim bị ed quá  :)

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

Tue_NV    3.912

Tue_NV
Đã đăng

Chuẩn rồi bác Nhoclangbat. Cảm ơn bác nhiều nhé. Nể mấy bác "cao thủ" làm thủ công vẫn tìm hết dim bị ed quá  :)

 

Lệnh FIND nó tự tìm cho mình hết đó bạn!

 

Dùng lệnh Find tìm chuỗi "~*<>*"

Dùng chức năng Select_All của lệnh Find

Chọn được rồi -> Muốn đổi gì thì cũng sẽ đơn giản rồi

Ra tiệm in mà quên mang theo Lisp thì sử dụng cái này bạn nhé! :D

 

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

pphung183    428

pphung183
Đã đăng

Dùng Vlax cải thiện tốc độ, nếu không có Text override thì khỏi tạo Layer "dimed", chỉ cần Text Dim đổi màu :)

(defun C:KTD( / ss ena obj txt n kq) 
(vl-load-com)
 (setq ss (ssget "X" '((0 . "DIMENSION"))))
(setq n 0)
 (while (setq ena (ssname ss 0)) (setq obj (vlax-ename->vla-object ena))
  (setq txt (cdr (assoc 1 (entget ena))))
(if (not (or (= txt "") (vl-string-search "<>" txt))) 
(progn
(if (not (tblsearch "layer" "Dimed"))
  (vl-cmdf "Layer" "N" "Dimed" "C" "1" "Dimed" ""))
 (vla-put-TextColor obj "1") 
(vla-put-layer obj "dimed")    (setq n (1+ n))
  ))
  (ssdel ena ss)
)
(if (= n 0) (setq kq "Ket qua check: OK")
  (setq kq (strcat "Co " (itoa n) " Dimensions bi sua Text"
           "\nDa duoc chuyen sang layer Dimed co Text mau 1!")
  )
)
(alert kq)
(princ))

 

 

- oh có anh Phung tham gia ^^, nhoc cũng mới sữa xong ^^, bạn xem sao

Lisp của Nhoc vẫn chưa xét trường hợp Text override có kí tự <> nên sẽ xem loại Dim này đã bị ED luôn :D
  • Vote tăng 3

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

Tue_NV    3.912

Tue_NV
Đã đăng

Chuỗi ~*<>* chứa nhiều thứ khác Dim nữa cơ mà.

 

Bác có thể dùng tùy chọn option của lệnh Find chỉ cho chọn Dim mà thôi!

  • 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

phongtran86    39

phongtran86
Đã đăng

Dùng Vlax cải thiện tốc độ, nếu không có Text override thì khỏi tạo Layer "dimed", chỉ cần Text Dim đổi màu :)

lisp này hay, dùng nhẹ. Bạn có thể chỉnh mình cái là chọn đổi màu trong những dim được chọn thôi chứ không phải tất cả của bản vẽ?

Cái thứ 2 nữa là. sau khi chỉnh lại kích thước thật bằng tay <> thì nó vẫn bị màu thế. Có cách nào khi gõ lệnh ktd -chọn kích thước các dim được chọn

- dim ed đổi màu như trên, còn những dim khi bị đỏ do gõ ktd lần trc (sau khi sưa thành <> ) sẽ về màu sắc của mặc định dimstyle đó. Thanks

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

pphung183    428

pphung183
Đã đăng

1/  Muốn tự chọn thì :

(setq ss (ssget "X" '((0 . "DIMENSION")))) sửa thành (setq ss (ssget '((0 . "DIMENSION"))))

2/ Muốn edit thằng dim nào đã bi sửa thì chọn trước các dim đó rồi dùng lệnh Find như bạn TUE -NV đã nói, Muốn chỉnh lại màu Text thì chọn các dim cần chỉnh, trong hộp properties

chọn màu Text color là xong :) .

  • 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

phongtran86    39

phongtran86
Đã đăng

1/  Muốn tự chọn thì :

(setq ss (ssget "X" '((0 . "DIMENSION")))) sửa thành (setq ss (ssget '((0 . "DIMENSION"))))

2/ Muốn edit thằng dim nào đã bi sửa thì chọn trước các dim đó rồi dùng lệnh Find như bạn TUE -NV đã nói, Muốn chỉnh lại màu Text thì chọn các dim cần chỉnh, trong hộp properties

chọn màu Text color là xong :) .

chỉnh thế thi mình bik nhưng thủ công. muốn gõ lệnh cái. tắt cả dim đã sửa lại đổi màu theo dimstyle :D

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

pphung183    428

pphung183
Đã đăng

chỉnh thế thi mình bik nhưng thủ công. muốn gõ lệnh cái. tắt cả dim đã sửa lại đổi màu theo dimstyle :D

Ekk :wub: ... Không thủ công đâu bạn. Muốn edit thằng dim nào đã bi sửa lại ban đầu khi đã dùng Lisp ktd.lsp thì chọn các dim cần chỉnh đúng, trong hộp properties mục Text thì thằng Text color là chọn màu, thằng Text override thì xóa trắng là chỉnh lại Dim thật. Thế thì OK rồi còn gì nữa ^_^ . Sở dỉ tôi nói đến lệnh Find ở đây là nghệ thuật sử dụng nó, bạn nên nghiên cứu thử nghiệm thêm Find sẽ phát hiện ra nhiều cái hay liên quan đến chuỗi kí tự Text :)

  • 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

phongtran86    39

phongtran86
Đã đăng

Mình là gv dạy cad mà :)). Cái này mình biết rồi. Chỉ viết li sp thì chi viet dc cái đơn giản. Còn lệnh cad mình nắm chắc cái này rồi :D

Lệnh đấy là lệnh fillet. tắt là fi mà :D

Ekk :wub: ... Không thủ công đâu bạn. Muốn edit thằng dim nào đã bi sửa lại ban đầu khi đã dùng Lisp ktd.lsp thì chọn các dim cần chỉnh đúng, trong hộp properties mục Text thì thằng Text color là chọn màu, thằng Text override thì xóa trắng là chỉnh lại Dim thật. Thế thì OK rồi còn gì nữa ^_^ . Sở dỉ tôi nói đến lệnh Find ở đây là nghệ thuật sử dụng nó, bạn nên nghiên cứu thử nghiệm thêm Find sẽ phát hiện ra nhiều cái hay liên quan đến chuỗi kí tự Text :)

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

master_worse    88

master_worse
Đã đăng (Đă chỉnh sửa)

Dùng 

 

(setq ss (ssget '((-4 . "<AND")(0 . "DIMENSION")(-4 . "<NOT")(1 . ",*<>*")(-4 . "NOT>")(-4 . "AND>"))))

 

để chọn các đường kích thước đã bị chỉnh sửa 

 

trong file lisp bên dưới:

 

layer MW-NOT_PLOT là không in.

các đường kích thước đã ở layer này sẽ không được chọn

 

file Lisp:

(defun c:ktd (/ ss cmdecho)
  (if (setq ss (ssget '((-4 . "<AND")
                        (0 . "DIMENSION")
                        (-4 . "<NOT")
                        (1 . ",*<>*")
                        (-4 . "NOT>")
                        (-4 . "<NOT")
                        (8 . "MW-NOT_PLOT")
                        (-4 . "NOT>")
                        (-4 . "AND>")
                       )
               )
      )
    (progn
      (princ (strcat "co " (itoa (sslength ss)) " duong kich thuoc da bi thay doi."))
      (or (tblsearch "LAYER" "MW-NOT_PLOT")
          (entmake (list '(0 . "LAYER")
                         '(100 . "AcDbSymbolTableRecord")
                         '(100 . "AcDbLayerTableRecord")
                         '(70 . 0)
                         (cons 2 "MW-NOT_PLOT")
                         (cons 62 203)
                         (cons 6 "Continuous")
                         (cons 290 0)
                   )
          )
      )
      (setq cmdecho (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (command "._change" ss "" "P" "LA" "MW-NOT_PLOT" "C" "BYLAYER" "")
      (setvar 'cmdecho cmdecho)
      (princ " cac doi tuong nay da duoc chuyen sang layer MW-NOT_PLOT")
    )
  )
  (princ)
)

 

(if (setq ss (ssget '((-4 . "<AND")
                        (0 . "DIMENSION")
                        (-4 . "<NOT")
                        (1 . ",*<>*")
                        (-4 . "NOT>")
                        (-4 . "<NOT")
                        (8 . "MW-NOT_PLOT")
                        (-4 . "NOT>")
                        (-4 . "AND>")
                       )
               )
      )
    (progn
      (princ (strcat "co " (itoa (sslength ss)) " duong kich thuoc da bi thay doi."))
      (or (tblsearch "LAYER" "MW-NOT_PLOT")
          (entmake (list '(0 . "LAYER")
                         '(100 . "AcDbSymbolTableRecord")
                         '(100 . "AcDbLayerTableRecord")
                         '(70 . 0)
                         (cons 2 "MW-NOT_PLOT")
                         (cons 62 203)
                         (cons 6 "Continuous")
                         (cons 290 0)
                   )
          )
      )
      (setq cmdecho (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (command "._change" ss "" "P" "LA" "MW-NOT_PLOT" "C" "BYLAYER" "")
      (setvar 'cmdecho cmdecho)
      (princ " cac doi tuong nay da duoc chuyen sang layer MW-NOT_PLOT")
    )
  )
  (princ)
 
(defun c:ktd (/ ss cmdecho)
  (if (setq ss (ssget '((-4 . "<AND")
                        (0 . "DIMENSION")
                        (-4 . "<NOT")
                        (1 . ",*<>*")
                        (-4 . "NOT>")
                        (-4 . "<NOT")
                        (8 . "MW-NOT_PLOT")
                        (-4 . "NOT>")
                        (-4 . "AND>")
                       )
               )
      )
    (progn
      (princ (strcat "co " (itoa (sslength ss)) " duong kich thuoc da bi thay doi."))
      (or (tblsearch "LAYER" "MW-NOT_PLOT")
          (entmake (list '(0 . "LAYER")
                         '(100 . "AcDbSymbolTableRecord")
                         '(100 . "AcDbLayerTableRecord")
                         '(70 . 0)
                         (cons 2 "MW-NOT_PLOT")
                         (cons 62 203)
                         (cons 6 "Continuous")
                         (cons 290 0)
                   )
          )
      )
      (setq cmdecho (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (command "._change" ss "" "P" "LA" "MW-NOT_PLOT" "C" "BYLAYER" "")
      (setvar 'cmdecho cmdecho)
      (princ " cac doi tuong nay da duoc chuyen sang layer MW-NOT_PLOT")
    )
  )
  (princ)
)
(defun c:ktd (/ ss cmdecho)
  (if (setq ss (ssget '((-4 . "<AND")
                        (0 . "DIMENSION")
                        (-4 . "<NOT")
                        (1 . ",*<>*")
                        (-4 . "NOT>")
                        (-4 . "<NOT")
                        (8 . "MW-NOT_PLOT")
                        (-4 . "NOT>")
                        (-4 . "AND>")
                       )
               )
      )
    (progn
      (princ (strcat "co " (itoa (sslength ss)) " duong kich thuoc da bi thay doi."))
      (or (tblsearch "LAYER" "MW-NOT_PLOT")
          (entmake (list '(0 . "LAYER")
                         '(100 . "AcDbSymbolTableRecord")
                         '(100 . "AcDbLayerTableRecord")
                         '(70 . 0)
                         (cons 2 "MW-NOT_PLOT")
                         (cons 62 203)
                         (cons 6 "Continuous")
                         (cons 290 0)
                   )
          )
      )
      (setq cmdecho (getvar 'cmdecho))
      (setvar 'cmdecho 0)
      (command "._change" ss "" "P" "LA" "MW-NOT_PLOT" "C" "BYLAYER" "")
      (setvar 'cmdecho cmdecho)
      (princ " cac doi tuong nay da duoc chuyen sang layer MW-NOT_PLOT")
    )
  )
  (princ)
)
Chỉnh sửa theo master_worse

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

pphung183    428

pphung183
Đã đăng

 

Liệu bạn có máy móc quá không (và cũng hơi cực đoan nữa) :D . Nếu đã vẽ bản vẽ để duyệt thì việc Edit dim là chẳng đặng đừng thôi bạn à. Do đó trong 1 bản vẽ chi tiết nếu có Edit dim thì tôi nghĩ chỉ tầm khoảng chục cái là cao. Bạn định dùng Lisp này để phát hiện và không cho những thằng đã bị Edit in ra :wacko: . Mục đích của Topic này chắc chủ Topic muốn kiểm tra Dim đã bị edit và sẽ cân nhắc cái nào nên chỉnh lại, cái nào nên giữ nguyên thôi bạn à :)

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

master_worse    88

master_worse
Đã đăng

Liệu bạn có máy móc quá không (và cũng hơi cực đoan nữa)

 

hơi cực đoan nên mới để ghi chú, chứ cực đoan là không thèm để ghi chú rồi. :P

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  
Người theo dõi 0
Về Đầu Trang AutoLisp
×