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

ndtnv

Thành viên
  • Số lượng nội dung

    548
  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    46

Bài đăng được đăng bởi ndtnv


  1. 3 giờ trước, Doan Nguyen Van đã nói:

    Bạn dùng thử lisp này xem, chưa test hết các trường hợp, mới đầu dùng ok 

    ...

    
    (vl-load-com)
    (defun c:xt (/ ss lstl ent ss1 lst lst2 en en2 en3 str)
    (setq ss  (ssget '((0 . "MTEXT"))))
      (command "_-OVERKILL" ss "" "D")
      (setq ss1 (ssadd) ent (entlast))
    (setq qa (getvar "QAFLAGS"))
    (setvar "QAFLAGS" 1)
    (command "._explode" ss "" )
    (setvar "QAFLAGS" qa)
      (while (setq ent (entnext ent))
     (setq ss1 (ssadd ent ss1)))
        (setq ss1 (acet-ss-to-list ss1))
        (setq ss1 (vl-sort ss1 '(lambda (x y) (cond	( (= (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget y)))) )
    					    (< (car (cdr (assoc 10 (entget x)))) (car (cdr (assoc 10 (entget y))))))
    					     ((> (cadr (cdr (assoc 10 (entget x)))) (cadr (cdr (assoc 10 (entget  y))))))  ))))
        (while (setq en (car ss1))
          (setq ss1 (cdr ss1))
          (setq lst2 (list en))
          (while (and (setq en2 (car ss1))
    		  (= (cadr (cdr (assoc 10 (entget en)))) (cadr (cdr (assoc 10 (entget en2)))) ) )
    	(setq ss1 (cdr ss1))
    	(setq lst2 (append lst2 (list en2)))
    	)
          (if (> (length lst2) 1) (progn
    	(setq str "")
    	(mapcar '(lambda (x) (setq str (strcat str (cdr (assoc 1 (entget x)))))) lst2)
    	(setq en3 (car lst2))
    	 (mapcar '(lambda (x) (entdel x) ) (cdr lst2))
    	(entmod (subst (cons 1 str) (assoc 1 (entget en3)) (entget en3)))
    	) )
          )
      (princ)
      )
    
    
    		
    
    		 (while (and (setq en2 (car ss1))
    		          (= (cadr (cdr (assoc 10 (entget en)))) (cadr (cdr (assoc 10 (entget en2)))) ) )
    		        (setq ss1 (cdr ss1))
    		        (setq lst2 (append lst2 (list en2)))
    		    )		
    
    

    Nếu chạy từng cụm nhỏ thì ổn.

    Xem đoạn code trên, lisp sẽ nối text từ Trường Sơn Đông vào text ở Trường Sơn Tây nếu có cùng y.

    Sao không xử lý từng MTEXT như lisp trước mà explode toàn bộ rồi mới xử lý?

     

    • Like 1

  2. Trong hình VD thì khoảng cách AB + CD > BC nên R bình quân ảnh hưởng nhiều đến kết quả.

    Các cách chia cho kết quả khác nhau do diện tích vi phân ds khá lớn so với dt S của toàn hình.

    Nếu ds -> 0, kết quả của các cách chia như nhau và bằng tích phân xác định của Li*ds trên S

    sau đây là 3 lisp 3 cách chia hcn, tam giác, đường tròn cho hcn a x b

    (chưa ktra kỹ, không biết có sai chỗ nào không)

    (defun LMeanR (a b m n / x y dx dy s)
        (setq s 0 dx (/ a n 1.) dy (/ b m 1.) y (/ dy 2) _00 (list 0 0))
        (repeat m
            (setq x (- (/ dx 2) (/ a 2.)))
            (repeat n
                (setq s (+ s (distance (list x y) _00)))
                (setq x (+ x dx))
            )
            (setq y (+ y dy))
        )
        (/ s m n)
    )
    (defun LMeanT (a b m n / x1 y1 x2 y2 dx dy s)
        (setq s 0 dx (/ a n 1.) dy (/ b m 1.) y (/ dy 2) y1 (- y (/ dy 3)) y2 (+ y (/ dy 3) ) _00 (list 0 0))
        (repeat m
            (setq x (- (/ dx 2) (/ a 2.))  x1 (- x (/ dx 3) ) x2 (+ x (/ dx 3)) )
            (repeat n
                (setq s (+ s (distance (list x1 y) _00) (distance (list x2 y) _00)(distance (list x y1) _00)(distance (list x y2) _00)))
                (setq x (+ x dx) x1 (+ x1 dx) x2 (+ x2 dx))
            )
            (setq y (+ y dy) y1 (+ y1 dy) y2 (+ y2 dy))
        )
        (/ s m n 4)
    )
    (defun ArcCos (x)
        (- (/ pi 2.0) (atan (/ x (sqrt (- 1.0 (* x x))))))
    )
    (defun LMeanC (a b dr / r dr an s sr)
        (setq s 0 sr 0 r (/ dr 2.) a2 (/ a 2.) ab (min a2 b) ba (max a2 b) _00 (list 0 0) c (distance (list a2 b) _00) p2 (/ pi 2))
        (while (<= r ab)
            (setq l (* p2 r) s (+ s l) sr (+ sr (* r l)) r (+ r dr)))
        (while (<= r ba)
            (setq l (* r (- p2 (ArcCos (/ ab r)))) s (+ s l) sr (+ sr (* r l)) r (+ r dr)))
        (while (<= r c)
            (setq l (* r (- p2 (ArcCos (/ ab r)) (ArcCos (/ ba r)))) s (+ s l) sr (+ sr (* r l)) r (+ r dr)))
        (/ sr s)
    )
    

    Test cho hình vuông 2 x 2 đều ra kq 1.18647

    (LmeanR 2 2 400 400)
    (LmeanT 2 2 200 200)
    (LmeanC 2 2 0.001)

    • Like 1

  3. Điểm A và D là trọng tâm 2 hình, có thể tính chính xác bằng cách chuyển thành REGION rồi lấy centroid.

    Điểm lấy đất là do bên thi công sắp xếp thuận lợi cho họ, thiết kế không cần quan tâm

    Theo tính toán thì nếu là hình vuông, nhân hệ số k = 1.19

    Hình 1, từ B nếu có thể đi ra ngoài phạm vi biên giới k = 1.15,

    nếu biên giới có hàng rào, k = 1.2

    Hình 2 do chiều rộng lớn hơn chiều sâu nên k = 1.25

    k trên chỉ là ước lượng, chính xác phải dùng chương trình.

    Nếu vẽ tay dùng các vòng tròn bán kính cách nhau khoảng 10 - 20m có thể đạt độ chính xác chấp nhận được

    Nếu có hàng rào thì phải phân thành nhiều vùng

    • Like 1

  4. Cách của Danh Cong sẽ nhỏ hơn cách chia vòng tròn.

    Cách chia vòng tròn chỉ đúng khi điểm ra có thể đi thẳng đến mọi điểm trong vùng.

    Nếu không đi thẳng được, chia thành các vùng nhỏ hơn

    Cách chính xác là vi phân thành các vùng có diện tích đủ nhỏ.

    Khi vi phân theo vòng tròn có ưu điểm số vùng chia sẽ nhỏ hơn so với theo hình vuông.

    Để dễ tính toán, vd có hình vuông cạnh 2

    K/c bq đến trung điểm 1 cạnh :

    Nếu chia 1x1: L = 1 (như Danh Cong)

    Nếu chia 2x2: L = ( sqrt(2.5) + sqrt(0.5) ) / 2 = 1.1441

    Nếu chia nxn đủ lớn : L = 1.1865 sai số đến gần 19%

    Nếu tính cho toàn thể từ nơi đào đến nơi đắp (cũng tính tương tự) cho hình như hình vẽ thì sai số cũng trên 5% là không thể bỏ qua.

    Muốn tính chính xác phải dùng lisp.

    Đây là công tác đất nên không cần phải chính xác lắm, vì vậy tính như Danh Cong nhân với hệ số 1.1 - 1.3 tùy theo tỉ lệ chiều rộng so với chiều dài khu đất là được

    • Vote tăng 1

  5. 2 giờ trước, duy782006 đã nói:

    Nhờ các bác viết giúp hàm tạo list chỉ chứa các số từ 1 chuỗi với. Nghĩa là khoàng trống, và các ký tự khác số  bỏ hết và cho ra list chỉ chứa các chuỗi chứa số.

    Mong muốn như này: Chuổi "1325   a21 hjjdf       254" thành list ("1325" "21" "254")

    Cám ơn!

    Nếu dùng acet

    (setq str  "1325   a021 hjjdf       254")
    (vl-remove-if ''((x) (= x ""))
        (acet-str-to-list " " (vl-list->string (mapcar ''((x)(if (<= 48 x 57) x 32)) (vl-string->list str)))))

    -> ("1325" "021" "254")

    • Vote tăng 1

  6. 13 giờ trước, ngokiet đã nói:

    Làm gì khó hiểu vậy. 4 hàm kia kết hợp làm 1 thì

    (setq LtsZichZac ((read(strcat “SortPoint_” style)) LtsPoint kccum)) 

    Tuy nhiên phải chắc chăn style là 1 trong 4 giá trị trên

     

    Bạn test xem dòng code dễ hiểu

    (setq LtsZichZac ((read(strcat “SortPoint_” style)) LtsPoint kccum)) 

    có chạy được không?

    Cách lập trình của tôi là kết hợp 4 hàm SortPoint thay cho kết hợp 4 lệnh gọi,   trên đó chỉ là VD kết hợp 4 lệnh gọi

    Có thể có cách kết hợp khác hay hơn, nếu bạn nào biết xin chia sẻ.


  7. Dùng bộ lọc

     '((0 . "MTEXT") (8 . "53")(-4 . "<AND")  (-4 . ">=") (40 . 0.299) (-4 . "<=") (40 . 0.3) (-4 . "AND>"))

    thay cho

    (list (cons 0 "MTEXT") (cons 40 tsz))

    có thể chọn toàn bộ bản vẽ 1 lần.

    Nếu sửa thuật toán thích hợp sẽ chạy đúng >99%

    Có 1 vài vị trí phải viết hàm riêng để xử lý bộ 5 mtext vd thửa 138

×