Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
11 replies to this topic

#1 qh2qa06

qh2qa06

    biết vẽ pline

  • Members
  • PipPip
  • 69 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 21 July 2014 - 09:36 AM

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.c...nh_venh_tam.doc


  • 0

#2 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 21 July 2014 - 09:41 AM

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


  • 0

#3 qh2qa06

qh2qa06

    biết vẽ pline

  • Members
  • PipPip
  • 69 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 23 July 2014 - 03:43 PM

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.c...ra_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.


  • 0

#4 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 23 July 2014 - 04:24 PM

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)  
)

  • 1

#5 qh2qa06

qh2qa06

    biết vẽ pline

  • Members
  • PipPip
  • 69 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 July 2014 - 04:20 PM

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!


  • 0

#6 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 28 July 2014 - 04:28 PM

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


  • 0

#7 qh2qa06

qh2qa06

    biết vẽ pline

  • Members
  • PipPip
  • 69 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 28 July 2014 - 04:33 PM

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.c..._venh_tam_2.dwg


  • 0

#8 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 28 July 2014 - 09:12 PM

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)
)

  • 1

#9 qh2qa06

qh2qa06

    biết vẽ pline

  • Members
  • PipPip
  • 69 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 29 July 2014 - 08:08 AM

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ả!


  • 0

#10 qh2qa06

qh2qa06

    biết vẽ pline

  • Members
  • PipPip
  • 69 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 30 July 2014 - 02:27 PM

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

  • 0

#11 Tot77

Tot77

    biết lệnh adcenter

  • Members
  • PipPipPipPipPipPipPip
  • 990 Bài viết
Điểm đánh giá: 498 (tốt)

Đã gửi 30 July 2014 - 05:27 PM

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

#12 hongnhung280991

hongnhung280991

    biết vẽ arc

  • Advance Member
  • PipPip
  • 44 Bài viết
Điểm đánh giá: -8 (bình thường)

Đã gửi 31 July 2014 - 09:20 AM

to_roi_t7_2014_copy_copy.jpg


  • 0