Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
tung89gt

NHờ chỉnh sửa lisp

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

Em chào các bác!

Em có sưu tập được 1 lisp tính khối lượng mline trên diễn đàn. không nhớ là của bác nào.

hiện tại em đang vướng mắc một chút là khi sử dụng lisp để tính khối lượng ở lệnh scale thì lisp chỉ quyét được các mline (cùng tỉ lệ scale) chưa lấy đối xứng. nhờ các bác sửa lisp quyét được cả các mline đã bị lấy đối xứng rồi giúp em với!

Em cảm ơn các bác!

Drawing1.dwg

LL.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
5 giờ trước, tung89gt đã nói:

Em chào các bác!

Em có sưu tập được 1 lisp tính khối lượng mline trên diễn đàn. không nhớ là của bác nào.

hiện tại em đang vướng mắc một chút là khi sử dụng lisp để tính khối lượng ở lệnh scale thì lisp chỉ quyét được các mline (cùng tỉ lệ scale) chưa lấy đối xứng. nhờ các bác sửa lisp quyét được cả các mline đã bị lấy đối xứng rồi giúp em với!

Em cảm ơn các bác!

Drawing1.dwg

LL.lsp

Chỉnh lại cho bạn nhé:

(defun c:LL ( / txt)

 (initget "ST LA SA")
 (setq txt (getkword "\nLoc MLINE theo [STyle/LAyer/SAcle] <LA>: "))
 (cond
   ((not txt)
   (setq kieu " thuoc STYLE: <") (setq mdxf 2))
   ((= "ST" txt)
   (setq kieu " thuoc STYLE: <") (setq mdxf 2))
   ((= "LA" txt)
   (setq kieu " thuoc LAYER: <") (setq mdxf 8))
   ((= "SA" txt)
   (setq kieu " co SCALE: <") (setq mdxf 40))
 )

(setq ketqua (cdr (assoc mdxf (entget (car (chonmotmline))))))
(setq ss (ssget (list (cons 0 "MLINE") (cons -4 "<OR") (cons mdxf ketqua) (cons mdxf (* ketqua -1) ) (cons -4 "OR>"))))
  (setq tot_len 0.0)
  (setq sml (sslength ss))

  (while (> (sslength ss) 0)
    (setq e_name (ssname ss 0))
    (setq e_record (entget e_name))
    (setq e_type (cdr (assoc '0 e_record)))
    (cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
	   (command "lengthen" e_name "")
	   (setq tot_len (+ tot_len (getvar "PERIMETER")))
	   (ssdel e_name ss)
	  )
	  ((wcmatch e_type "MLINE") (add_mline))
	  (e_type (ssdel e_name ss))
    )
  )

  (cond ((= "SA" txt) (setq ketqua (rtos ketqua 2 2)) ))
  (prompt (strcat "\nTim thay: " (itoa sml) " doi tuong MLINE" kieu ketqua "> tong chieu dai=" (rtos tot_len 2 2)))


(princ))
;;;;;;;;;;;;;;
(defun chonmotmline ( / dchon)
(setq dchon (entsel "\nChon Mline chuan:"))
(while
(or
(null (car dchon))
(and (/= "MLINE" (cdr (assoc 0 (entget (car dchon)))))
)
)
(princ "\nDoi tuong khong phai MLINE. Chon lai !")
(setq dchon (entsel))
)
dchon)
;;;;;;;;;;;;;;
(defun add_mline ()
  (foreach e_record_sub	e_record
    (cond ((= 10 (car e_record_sub))
	   (setq pt1	   (cdr e_record_sub)
		 mline_len 0.0
	   )
	  )
	  ((= 11 (car e_record_sub))
	   (setq pt2	   (cdr e_record_sub)
		 mline_len (+ mline_len (distance pt2 pt1))
		 pt1	   pt2
	   )
	  )
    )
  )
  (setq tot_len (+ tot_len mline_len))
  (ssdel e_name ss)
)

 

  • 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
10 giờ trước, huunhantvxdts đã nói:

Chỉnh lại cho bạn nhé:


(defun c:LL ( / txt)

 (initget "ST LA SA")
 (setq txt (getkword "\nLoc MLINE theo [STyle/LAyer/SAcle] <LA>: "))
 (cond
   ((not txt)
   (setq kieu " thuoc STYLE: <") (setq mdxf 2))
   ((= "ST" txt)
   (setq kieu " thuoc STYLE: <") (setq mdxf 2))
   ((= "LA" txt)
   (setq kieu " thuoc LAYER: <") (setq mdxf 8))
   ((= "SA" txt)
   (setq kieu " co SCALE: <") (setq mdxf 40))
 )

(setq ketqua (cdr (assoc mdxf (entget (car (chonmotmline))))))
(setq ss (ssget (list (cons 0 "MLINE") (cons -4 "<OR") (cons mdxf ketqua) (cons mdxf (* ketqua -1) ) (cons -4 "OR>"))))
  (setq tot_len 0.0)
  (setq sml (sslength ss))

  (while (> (sslength ss) 0)
    (setq e_name (ssname ss 0))
    (setq e_record (entget e_name))
    (setq e_type (cdr (assoc '0 e_record)))
    (cond ((wcmatch e_type "LINE,ARC,CIRCLE,POLYLINE,LWPOLYLINE,ELLIPSE,SPLINE")
	   (command "lengthen" e_name "")
	   (setq tot_len (+ tot_len (getvar "PERIMETER")))
	   (ssdel e_name ss)
	  )
	  ((wcmatch e_type "MLINE") (add_mline))
	  (e_type (ssdel e_name ss))
    )
  )

  (cond ((= "SA" txt) (setq ketqua (rtos ketqua 2 2)) ))
  (prompt (strcat "\nTim thay: " (itoa sml) " doi tuong MLINE" kieu ketqua "> tong chieu dai=" (rtos tot_len 2 2)))


(princ))
;;;;;;;;;;;;;;
(defun chonmotmline ( / dchon)
(setq dchon (entsel "\nChon Mline chuan:"))
(while
(or
(null (car dchon))
(and (/= "MLINE" (cdr (assoc 0 (entget (car dchon)))))
)
)
(princ "\nDoi tuong khong phai MLINE. Chon lai !")
(setq dchon (entsel))
)
dchon)
;;;;;;;;;;;;;;
(defun add_mline ()
  (foreach e_record_sub	e_record
    (cond ((= 10 (car e_record_sub))
	   (setq pt1	   (cdr e_record_sub)
		 mline_len 0.0
	   )
	  )
	  ((= 11 (car e_record_sub))
	   (setq pt2	   (cdr e_record_sub)
		 mline_len (+ mline_len (distance pt2 pt1))
		 pt1	   pt2
	   )
	  )
    )
  )
  (setq tot_len (+ tot_len mline_len))
  (ssdel e_name ss)
)

 

Tuyệt vời! Lisp chạy ngon rồi bác ạ, Em cảm ơn bác rất nhiều.

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
1 giờ trước, tung89gt đã nói:

Tuyệt vời! Lisp chạy ngon rồi bác ạ, Em cảm ơn bác rất nhiều.

Bạn thử chạy trường hợp lọc mline Layer hoặc Style xem sao.

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
1 giờ} trướ}c, NTHAHT đã nói:

Bạn thử chạy trường hợp lọc mline Layer hoặc Style xem sao.

Em đã chạy thử trường hợp lọc theo layer và style thì thấy đều báo lỗi. nhưng nhu cầu hiện tại thì em chỉ chủ yếu dùng lọc theo scale thôi bác ạ. bác có thể chỉnh thêm giúp em là sau khi ấn lệnh thì lisp sẽ bỏ qua phần lựa chọn thuộc tính đi và chạy thẳng vào phần chọn đối tượng mẫu ( theo scale) xong rồi quét chọn vùng chứa các đối tượng được không bác.

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  

×