Chuyển đến nội dung
Diễn đàn CADViet
NGUYENVANHIEUGTVT

Nhờ mọi người trợ giúp Lisp tính tổng Dimension

Bởi NGUYENVANHIEUGTVT , trong AutoLisp

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

NGUYENVANHIEUGTVT    7

NGUYENVANHIEUGTVT
Đã đăng

Mình tìm trên diễn đàn có lisp tính tổng Dimensions này. Nhờ mọi người sửa chút lisp này là lúc quét chọn đối tượng Dimensions thì bỏ qua k chọn đối tượng là "Bán kính".
Và kết quả tổng Dimensions sẽ ghi vào sau chữ "L=" như trên hình. Mong mọi người hỗ trợ mình vơi ạ.. 
cảm ơn mọi người nhiều !

image.png.53f20e2d2041c1f4f37f9dafc0ecb9a6.png

congdim_trudim.lsp

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

quansla    259

quansla
Đã đăng

Nói bán kính thì mình chỉ xử lý bán kính nhé ^T^  

;; free lisp from cadviet.com
;;; this lisp was downloaded from https://www.cadviet.com/forum/topic/205-vi%E1%BA%BFt-lisp-theo-y%C3%AAu-c%E1%BA%A7u/?page=84&tab=comments#comment-62720
(defun c:TTD(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim cong:")
(setq ss (ssget '((0 . "DIMENSION")
		  (-4 . "<not")
		  (100 . "AcDbDimension")
		  (-4 . "not>")
		  )))

(setq n (sslength ss) i 0 S 0 duyet 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)


(alert (rtos S 2 0))

(princ)
)
(defun c:Trudim(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim lam so bi tru :")
(setq ss (ssget '((0 . "DIMENSION"))))

(prompt "\n Chon cac Dim lam so tru :")
(setq ss (ssget '((0 . "DIMENSION")
		  (-4 . "<not")
		  (100 . "AcDbDimension")
		  (-4 . "not>")
		  )))

(setq n (sslength ss) i 0 S 0 duyet 0)
(setq nt (sslength sst) j 0 St 0 duyett 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)

(while (< j nt)
(setq entt (entget(ssname sst j)))

(if (= (cdr(assoc 1 entt)) "")
(setq duyett (cdr(assoc 42 entt)))
(setq duyett (atof(cdr(assoc 1 entt))))
)
(setq St (+ St duyett))
(setq j (1+ j))
)

(setq Skq (- S St))

(alert (rtos Skq 2 0))

(princ)
)

 

  • Like 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

NGUYENVANHIEUGTVT    7

NGUYENVANHIEUGTVT
Đã đăng
23 giờ trước, quansla đã nói:

Nói bán kính thì mình chỉ xử lý bán kính nhé ^T^ 

  • ttd_trudim.lsp
    lisp help
  •   

;; free lisp from cadviet.com
;; this lisp was downloaded from https://www.cadviet.com/forum/topic/205-vi%E1%BA%BFt-lisp-theo-y%C3%AAu-c%E1%BA%A7u/?page=84&tab=comments#comment-62720
(defun c:TTD(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim cong:")
(setq ss (ssget '((0 . "DIMENSION")
		  (-4 . "<not")
		  (100 . "AcDbDimension")
		  (-4 . "not>")
		  )))

(setq n (sslength ss) i 0 S 0 duyet 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)


(alert (rtos S 2 0))

(princ)
)
(defun c:Trudim(/ ss n i S duyet ent sst nt j St duyett entt Skq)
(prompt "\n Chon cac Dim lam so bi tru :")
(setq ss (ssget '((0 . "DIMENSION"))))

(prompt "\n Chon cac Dim lam so tru :")
(setq ss (ssget '((0 . "DIMENSION")
		  (-4 . "<not")
		  (100 . "AcDbDimension")
		  (-4 . "not>")
		  )))

(setq n (sslength ss) i 0 S 0 duyet 0)
(setq nt (sslength sst) j 0 St 0 duyett 0)

(while (< i n)
(setq ent (entget(ssname ss i)))

(if (= (cdr(assoc 1 ent)) "")
(setq duyet (cdr(assoc 42 ent)))
(setq duyet (atof(cdr(assoc 1 ent))))
)
(setq S (+ S duyet))
(setq i (1+ i))
)

(while (< j nt)
(setq entt (entget(ssname sst j)))

(if (= (cdr(assoc 1 entt)) "")
(setq duyett (cdr(assoc 42 entt)))
(setq duyett (atof(cdr(assoc 1 entt))))
)
(setq St (+ St duyett))
(setq j (1+ j))
)

(setq Skq (- S St))

(alert (rtos Skq 2 0))

(princ)
)

 

Bác kiểm tra lại lisp dùm e cái, quét chọn đối tượng Dim k được !

  • 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

quansla    259

quansla
Đã đăng

Oa hôm nay xem tin nhắn bạn nhắn riêng mới để ý lại, đúng rồi lisp không thể hoạt động được mình quên mất DXF70 của Dim

  

(defun c:tinh_tong_dim( / ent S dt lst_loc)
    (vl-load-com)
    (defun tinh_bit(N / kq r)
    (setq r '() kq 0)
    (while (and (/= N 0)
		(/= 0 (setq kq (fix (/ (log N ) (log 2 ))))))
      (setq r (append r (list kq))
	    N (rem N (expt 2 kq)))
      )
    (if (= N 0)
      (setq r r)
      (setq r (append r (list 0))))
    (mapcar '(lambda (x) (expt 2 x)) r)
    )





  
  (setq S 0)

  ;Muon bo loai gi thi de ten no vao day
  (setq lst_loc '(4 3 2))
  ;Vi du o day la bo 4=ban kinh    3 = duong kinh   2=doc goc
  
;;;0 = Rotated, horizontal, or vertical
;;;1 = Aligned Dim Align
;;;2 = Angular Dim Goc
;;;3 = Diameter Dim duong kinh
;;;4 = Radius   Dim ban kinh
;;;5 = Angular 3-point Dim Cung tron ???
;;;6 = Ordinate Thuong ????

  
  (foreach dt (acet-ss-to-list (ssget '(( 0 . "*DIM*"))))
    (setq ent (entget dt))
    (if (not (member (apply '+ (vl-remove-if '(lambda (x) (member x '(32 64 128))) (tinh_bit (cdr (assoc 70 ent))))) lst_loc))
      (setq S (+ S (if (/= "" (cdr (assoc 1 ent))) (atof(cdr (assoc 1 ent))) (cdr (assoc 42 ent))))))
    )
  (princ (rtos S 2 4))
  (alert (strcat "L=" (rtos S 2 4)))
  (if (setq ss (ssget ":S" '((0 . "*TEXT"))))
    (progn
      (setq ent (entget (ssname ss 0))
	    txt (cdr(assoc 1 ent)))
      (if (setq pos (vl-string-search "=" txt))
	(setq txt (strcat (substr txt 1 (1+ pos)) (rtos S 2 4)))
	(setq txt (strcat "L=" (rtos S 2 4))))
    (entmod (subst (cons 1 txt) (assoc 1 ent) ent)))
    )
  (princ)
  )

Trong đoạn lisp trên mình đã để đoạn để bạn có thể sửa

(setq lst_loc '(4 3 2 5))

 

 

Tương ứng các số mình đã gi trong lisp, nếu bạn để số nào thì Dim tương ứng với số đó sẽ không được tính tổng

 

P/S phần tính Dim trừ khá dễ nhưng mình chưa ưng code trên lắm; Làm phiền mọi người trên diễn đàn góp ý giúp về Code được không ạ, cứ thấy có gì đó chưa ổn và cách để chọn đối tượng ban đầu nữa, giá mà nó lọc ngay từ lúc quét chọn thì tốt, ai có cách nào hay không ạ, Xin cảm ơn

 

 

Ghi chú cách sử dụng LISP

B1. Gõ lệnh Tinh_tong_dim

B2. Quét chọn tất cả các dim cần tính (LISP sẽ tự động loại bỏ không tính số liệu của "Bán kính" "đường kính" và "đo góc"

B3. LISP sẽ hiện kết quả dạng hộp thoại 

B4. Chọn Text/Mtext cần thay kết quả

Kết thúc lisp

  • 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

ndtnv    481

ndtnv
Đã đăng

Lisp của quansla

Nếu lọc '(4 3 2) thì chọn cả dim angular

Nếu lọc '(4 3 2 5) thì bỏ mất arc length dim

Hàm tính bit N có thể rút gọn (rem N 32)

Tham khảo cách lọc dim :

Nếu quansla chưa làm được, tôi sẽ viết nếu rãnh

  • 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

thiep    365

thiep
Đã đăng

Một cách lọc các kiểu dimension khác. Nhưng để trực quan, Thiệp viết thêm 1 hộp thoại. Giá trị mặc nhiên ban đầu được chọn là:

- Kiểu AlignedDimension,

- Chỉ cộng DIm Orgin (chưa chỉnh sửa textDim)

- Sai số cuối cùng là 0

- Đưa tổng dim ra 1 text có sẵn.

 

sumdim.rar

  • Like 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

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
Về Đầu Trang AutoLisp
×