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.
qh2qa06

Xin lisp kiểm tra độ vênh của tấm BTXM

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

Nhờ mọi người viết giúp lisp kiểm tra độ vênh của tấm BTXM theo công thức trong mẫu file đính kèm.

Dữ liệu có 4 cao độ tại đúng 4 đỉnh tấm BTXM.

Cảm ơn mọi người!http://www.cadviet.com/upfiles/3/64018_cong_thuc_tinh_venh_tam.doc

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

Bạn phải đưa thêm file cad để test và biết tấm là gì, line, pline... cao độ góc là gì, text, mtext, att...

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

Bạn phải đưa thêm file cad để test và biết tấm là gì, line, pline... cao độ góc là gì, text, mtext, att...

http://www.cadviet.com/upfiles/3/64018_kiem_tra_venh_tam.dwg

Mình muốn có lisp hỗ trợ để khi tính độ vênh chỉ cần bấm vào 4 text là tính ra được độ vênh là bao nhiêu. Nếu độ vênh <=1% thì báo là OK.

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

Bạn thử cái này, điều kiện là text canh trái, tấm là lwpolyline.

 

(defun c:test(/ ss ssl txt lwp canhngan caodo venh kq)
  (setq ss (ssget '((0 . "TEXT,LWPOLYLINE")))
ssl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
txt (vl-remove-if '(lambda(x) (= "LWPOLYLINE" (cdr (assoc 0 (entget x))))) ssl)
lwp (car (vl-remove-if '(lambda(x) (= "TEXT" (cdr (assoc 0 (entget x))))) ssl)  )
lwp (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= 10 (car x))) (entget lwp)))
lwp (mapcar '(lambda(z) (list z 
     (car (vl-sort txt '(lambda(x y) (< (distance (cdr (assoc 10 (entget x))) z)
(distance (cdr (assoc 10 (entget y))) z))))))) lwp)
lwp (mapcar '(lambda(x) (list (car x) (atof (cdr (assoc 1 (entget (last x))))))) lwp)
canhngan (min (distance (car (nth 0 lwp)) (car (nth 1 lwp)))
     (distance (car (nth 0 lwp)) (car (nth 3 lwp))))
caodo (mapcar 'cadr lwp)
venh (if (<= (setq kq (/ (abs (- (+ (nth 0 caodo) (nth 2 caodo)) (+ (nth 1 caodo) (nth 3 caodo)))) canhngan 1.0)) 0.01)
      (princ (strcat "\nDo venh = " (rtos kq) " <= 1%"))
      (princ (strcat "\nDo venh = " (rtos kq) " > 1%")))        
  ) (princ)  
)
  • 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

 

Bạn thử cái này, điều kiện là text canh trái, tấm là lwpolyline.

 

(defun c:test(/ ss ssl txt lwp canhngan caodo venh kq)
  (setq ss (ssget '((0 . "TEXT,LWPOLYLINE")))
ssl (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
txt (vl-remove-if '(lambda(x) (= "LWPOLYLINE" (cdr (assoc 0 (entget x))))) ssl)
lwp (car (vl-remove-if '(lambda(x) (= "TEXT" (cdr (assoc 0 (entget x))))) ssl)  )
lwp (mapcar 'cdr (vl-remove-if-not '(lambda(x) (= 10 (car x))) (entget lwp)))
lwp (mapcar '(lambda(z) (list z 
     (car (vl-sort txt '(lambda(x y) (< (distance (cdr (assoc 10 (entget x))) z)
(distance (cdr (assoc 10 (entget y))) z))))))) lwp)
lwp (mapcar '(lambda(x) (list (car x) (atof (cdr (assoc 1 (entget (last x))))))) lwp)
canhngan (min (distance (car (nth 0 lwp)) (car (nth 1 lwp)))
     (distance (car (nth 0 lwp)) (car (nth 3 lwp))))
caodo (mapcar 'cadr lwp)
venh (if (<= (setq kq (/ (abs (- (+ (nth 0 caodo) (nth 2 caodo)) (+ (nth 1 caodo) (nth 3 caodo)))) canhngan 1.0)) 0.01)
      (princ (strcat "\nDo venh = " (rtos kq) " <= 1%"))
      (princ (strcat "\nDo venh = " (rtos kq) " > 1%")))        
  ) (princ)  
)

Lisp của bạn đã đáp ứng yêu cầu của mình. Bạn có thể chỉnh giúp mình là lisp sẽ tính cạnh của hình chữ nhật từ vị trí của text luôn được không? Mình sẽ không phải vẽ hình chữ nhật nữa, giảm được một bước vì mặt bằng của mình rất rộng.

Cảm ơn bạn 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

Tưởng bạn vẽ tấm trước rồi mới ghi chữ sau chứ? Vậy tấm luôn là hình chữ nhật hay là có hình bình hành, thoi, thang...?

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ưởng bạn vẽ tấm trước rồi mới ghi chữ sau chứ? Vậy tấm luôn là hình chữ nhật hay là có hình bình hành, thoi, thang...?

Tấm luôn là hình chữ nhật, chính là tấm BTXM như kiểu tấm trên sân lăng HCM í, nhưng bọn mình không vẽ 1 tấm bằng 1 hình chữ nhật mà nó sẽ là cả mặt bằng được vẽ bằng các đường Polyline giao cắt với nhau, tại vị trí giao cắt là điểm cao độ. Để mình gửi cho bạn xem một bản tổng thể kiểu đó nhé!

http://www.cadviet.com/upfiles/3/64018_kiem_tra_venh_tam_2.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

Tưởng bạn làm số lượng ít và rời rac, chứ nhiều như vậy thì dù có lisp mà cứ quét 4 cái như trên thấy cũng khá là vất vả.

Thôi làm "rướn" thêm cho bạn cái này, bạn có thể chọn nhiều hàng nhiều cột 1 lúc, cái nào không ok thì sẽ chuyển màu đỏ và có ghi độ vênh. Khi chọn đừng chọn text trùng lên nhau.

Và điều quan trọng là các hàng đều nằm ngang giống file bạn đưa chứ không xiên xéo.

 

(defun test(l / canhngan caodo kq)     
  (setq canhngan (min (distance (caar l) (car (nth 1 l)))
     (distance (caar l) (car (nth 2 l))))       
caodo (mapcar '(lambda(x) (atof (cdr (assoc 1 (entget (last x)))))) l))
  
  (if (> (setq kq (/ (abs (- (+ (nth 0 caodo) (nth 3 caodo))
   (+ (nth 1 caodo) (nth 2 caodo)))) canhngan 1.0)) 0.01)
    (progn 
      (mapcar '(lambda(x) (command "change" (last x) "" "P" "c" "1" "")) l)
      (princ (strcat "\nDo venh " (rtos kq) " > 1%"))
    )
  )
  (princ)  
)
 
(defun c:test(/ tm0 tm tm1 cao n m hang cot a b)
  (setvar 'cmdecho 0)
  (prompt "\nChon text :")
  (setq tm0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT"))))))
tm0 (mapcar '(lambda(x) (list (cdr (assoc 10 (entget x))) x)) tm0)
tm0 (vl-sort tm0 '(lambda(x y) (< (cadar x) (cadar y))))
cao (cdr (assoc 40 (entget (last (car tm0)))))
tm nil
  )
  (while tm0
    (setq tm1 (vl-sort (vl-remove-if-not
'(lambda(x) (equal (cadr (caar tm0)) (cadar x) cao)) tm0)
    '(lambda (x y) (< (caar x) (caar y)) )) 
 tm0 (vl-remove-if
'(lambda(x) (equal (cadr (caar tm0)) (cadar x) cao)) tm0)
 tm (append tm (list tm1))
    )
  )
  (setq m -1
hang (length tm)
cot (length (car tm)))
  (repeat (1- hang)
      (setq n -1
   m (1+ m)
   a (nth m tm)
   b (nth (1+ m) tm))
      (repeat (1- cot)
        (setq n (1+ n))
(test (list (nth n a) (nth (1+ n) a) (nth n b) (nth (1+ n) b)))
      )
  )
  (setvar 'cmdecho 1)
  (princ)
)
  • 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

Tưởng bạn làm số lượng ít và rời rac, chứ nhiều như vậy thì dù có lisp mà cứ quét 4 cái như trên thấy cũng khá là vất vả.

Thôi làm "rướn" thêm cho bạn cái này, bạn có thể chọn nhiều hàng nhiều cột 1 lúc, cái nào không ok thì sẽ chuyển màu đỏ và có ghi độ vênh. Khi chọn đừng chọn text trùng lên nhau.

Và điều quan trọng là các hàng đều nằm ngang giống file bạn đưa chứ không xiên xéo.

 

(defun test(l / canhngan caodo kq)     
  (setq canhngan (min (distance (caar l) (car (nth 1 l)))
     (distance (caar l) (car (nth 2 l))))       
caodo (mapcar '(lambda(x) (atof (cdr (assoc 1 (entget (last x)))))) l))
  
  (if (> (setq kq (/ (abs (- (+ (nth 0 caodo) (nth 3 caodo))
   (+ (nth 1 caodo) (nth 2 caodo)))) canhngan 1.0)) 0.01)
    (progn 
      (mapcar '(lambda(x) (command "change" (last x) "" "P" "c" "1" "")) l)
      (princ (strcat "\nDo venh " (rtos kq) " > 1%"))
    )
  )
  (princ)  
)
 
(defun c:test(/ tm0 tm tm1 cao n m hang cot a b)
  (setvar 'cmdecho 0)
  (prompt "\nChon text :")
  (setq tm0 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (ssget '((0 . "TEXT"))))))
tm0 (mapcar '(lambda(x) (list (cdr (assoc 10 (entget x))) x)) tm0)
tm0 (vl-sort tm0 '(lambda(x y) (< (cadar x) (cadar y))))
cao (cdr (assoc 40 (entget (last (car tm0)))))
tm nil
  )
  (while tm0
    (setq tm1 (vl-sort (vl-remove-if-not
'(lambda(x) (equal (cadr (caar tm0)) (cadar x) cao)) tm0)
    '(lambda (x y) (< (caar x) (caar y)) )) 
 tm0 (vl-remove-if
'(lambda(x) (equal (cadr (caar tm0)) (cadar x) cao)) tm0)
 tm (append tm (list tm1))
    )
  )
  (setq m -1
hang (length tm)
cot (length (car tm)))
  (repeat (1- hang)
      (setq n -1
   m (1+ m)
   a (nth m tm)
   b (nth (1+ m) tm))
      (repeat (1- cot)
        (setq n (1+ n))
(test (list (nth n a) (nth (1+ n) a) (nth n b) (nth (1+ n) b)))
      )
  )
  (setvar 'cmdecho 1)
  (princ)
)

Làm cả mặt bằng không vất đâu, công việc hàng ngày của bọn mình là làm lưới cao độ mà. Từ lưới này, nhà thầu thi công sẽ đưa ra thực tế. Đó là mặt bằng đường sân bay nên cần chính xác từng mắt lưới một. Ngoài cao độ còn tính khối lượng, diện tích trên từng ô vuông.

Cảm ơn bạn đã giúp! Chúc bạn ngày mới làm việc hiệu 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

Cho mình hỏi hôm qua mình thử thấy ổn rồi, hôm nay dùng lại báo lỗi như sau:

; error: bad argument type: lentityp nil

Lỗi này là bị làm sao và sửa thế nào? Mình muốn sửa lệnh thành vt (thay cho test) có được không?

Select objects: Specify opposite corner: 716 found
 
Select objects:  ; error: bad argument type: lentityp nil

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

Chắc tại bạn chọn mtext thay vì text nên nó báo lỗi, bạn tìm chỗ có (0 . "TEXT") đổi thành (0 . "*TEXT")

còn đổi tên lệnh thì c:test -> c:vt

  • 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

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


×