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

[Nhờ viết lisp] tính chênh cao cho mắt lưới

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

Chào các bác trong diễn đàn!

Trong công việc em có phát sinh một công đoạn lặp lại là lấy giá trị của text CDTK - CDTN ra chênh cao, em làm thì có rất nhiều mắt lưới nên làm rất tốn thời gian vì vậy em lập topic để mong các bác giúp em viết 1 lisp với nội dung như sau:

Trên bản vẽ có:

-Các  text CDTN, CDTK, Chenhcao có điểm đặt trùng nhau hoặc cách nhau 1 khoảng rất nhỏ  (Em có kèm theo bản vẽ để các bác dễ giúp đỡ)

Lisp mong muốn:

-Gõ lệnh và lisp hỏi chọn CDTN chọn xong hỏi tiếp chọn CDTK và hỏi tiếp chọn text Chenhcao  (dùng chuột quét toàn bộ 1 vùng nào đó để chọn đối tượng)

-Lisp tính ra chênh cao của các text đặt gần nhau với 1 khoảng nào đó chẳng hạn mà người dùng nhập vào và gán chênh cao đó cho các text thuộc layer Chenhcao đặt gần đó.

Mong các bác trong diễn đàn giúp đỡ.

Cảm ơn các bác!http://www.cadviet.com/upfiles/3/49411_ban_ve_mau.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

Những cái text đó nằm gần nhau sẵn rồi cần gì hỏi nhập khoảng câch làm chi? tôi cho nó = 1 (kc tối đa)

bạn thử cái này. Tuy có thể quét chọn toàn bộ bản vẽ, nhưng để kiểm tra thì chỉ nên quét 1 phần tùy theo mắt bạn để tìm sự thay đổi trị số.

 

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun gan(v l)
    (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
  )
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex
(ssget '((0 . "TEXT") (8 . "CDTN,CDTK,CHENH CAO")))))) 
sstk (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CDTK")) ss)
sstn (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CDTN")) ss)
        sscc (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "Chenh cao")) ss))
  (while sstk
    (setq v (car sstk)
 sstk (cdr sstk)
 cdtk (atof (dxf 1 v))
 tm   (gan v sstn)
 cc   (gan v sscc))
    (if (and tm cc)
       (setq  cdtn (atof (dxf 1 tm))
     sstn (vl-remove tm sstn) 
     sscc (vl-remove cc sscc)
     tm1 (entmod (subst (cons 1 (rtos (abs (* 100 (- cdtn cdtk))) 2 1)) (assoc 1 (entget cc)) (entget cc)))
)
    )   
  )
  (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

Cảm ơn bác Tot77 nhiều. phần khoảng cách thì em muốn lựa chọn nhập vào vì đôi khi bản vẽ của người khác sẽ dịch đi 1 khoảng nào đó để tránh phải move về gần nhau thì có thể nhập khoảng cách vào. Đoạn nhập khoảng cách thì em có thể tự sửa được, Cảm ơn bác lần nữa.

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

Em cũng cần tính chênh cao nên em post luôn vào đây.

Em đã có Text Cao độ Thiết kế và Text Cao độ tự nhiên. Bây giờ em cần tính Chênh cao và điền luôn vào cùng vị trí điểm tính ra, điền tự động luôn ạ. Các bác giúp em được không?

Em xin cảm ơn ạ!

 

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

- hihi nhoc lại xon xen , nếu layer "CC" của bạn là chênh chao, thì bạn chỉ cần tải lsp trên về mở ra sữa chỗ nào có chữ "Chenh cao" trong lsp thành "CC" là ok rùi, có 2 chỗ thui nhanh mà ^^

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

Thì sửa cái lsp trên 1 chút, nhưng ở đây thấy có 3 số lẻ và không nhân 100.

 

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
 (defun dxf (id v) (cdr (assoc id (entget v))))
 (defun gan(v l)
  (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
 )
 (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex
(ssget "X" '((0 . "TEXT") (8 . "CDTN,CDTK,CC"))))))
       sstk (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CDTK")) ss)
       sstn (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CDTN")) ss)
       sscc (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CC")) ss))
 (while sstk
  (setq v (car sstk)
sstk (cdr sstk)
cdtk (atof (dxf 1 v))
tm (gan v sstn)
cc (gan v sscc))
  (if (and tm cc)
   (setq cdtn (atof (dxf 1 tm))
sstn (vl-remove tm sstn)
sscc (vl-remove cc sscc)
tm1 (entmod (subst (cons 1 (rtos (- cdtk cdtn) 2 3)) (assoc 1 (entget cc)) (entget cc)))
    )
  )
 )
 (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

Gõ lệnh một phát là có kết quả luôn, kỳ diệu quá!

 

Thì sửa cái lsp trên 1 chút, nhưng ở đây thấy có 3 số lẻ và không nhân 100.

 

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun gan(v l)
    (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
  )
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex
(ssget "X" '((0 . "TEXT") (8 . "CDTN,CDTK,CC"))))))
sstk (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CDTK")) ss)
sstn (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CDTN")) ss)
        sscc (vl-remove-if-not '(lambda(x) (= (dxf 8 x) "CC")) ss))
  (while sstk
    (setq v (car sstk)
 sstk (cdr sstk)
 cdtk (atof (dxf 1 v))
 tm  (gan v sstn)
 cc  (gan v sscc))
    (if (and tm cc)
       (setq cdtn (atof (dxf 1 tm))
    sstn (vl-remove tm sstn)
    sscc (vl-remove cc sscc)
    tm1 (entmod (subst (cons 1 (rtos (abs  (- cdtn cdtk)) 2 3)) (assoc 1 (entget cc)) (entget cc)))
    )
    )
  )
  (princ)
) 
 
 

Nhưng layer để tính sẽ phải là CDTK, CDTN và CC đúng không ạ?

Em cảm ơn bác!

Bác ơi giá trị CC = CDTK-CDTN. Lisp của bác đang tính là lấy số lớn trừ số nhỏ nên kết quả tính không đúng trên toàn bộ mặt bằng. Kết quả Chênh cao của em có cả giá trị âm (-), dương (+) và 0. Âm là đào, dương là đắp.

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

Đã sửa và up lại ở #6.

Em muốn anh chỉnh giúp em là Cao độ thiết kế được chọn Layer chứ không cố định là CDTK, tương tự Cao độ tự nhiên và Chênh cao cũng chọn Layer tương ứng chứ không cố định là CDTN và CC có được không ạ?

  • 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

Bạn dùng cái này. Nó chỉ hỏi 1 lần thôi.

 

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun gan(v l)
   (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
  )
  (if (not laylist)
    (setq laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do thiet ke :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do tu nhien :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Chenh cao :"))) laylist)
    )
  )      
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex
(ssget "X" (list '(0 . "TEXT") (cons 8 (strcat (car laylist)"," (cadr laylist) "," (last laylist))))))))
sstk (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (last laylist))) ss)
sstn (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (cadr laylist))) ss)
sscc (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (car laylist))) ss))
(while sstk
 (setq v (car sstk)
       sstk (cdr sstk)
       cdtk (atof (dxf 1 v))
       tm (gan v sstn)
       cc (gan v sscc))
 (if (and tm cc)
    (setq cdtn (atof (dxf 1 tm))
 sstn (vl-remove tm sstn)
 sscc (vl-remove cc sscc)
 tm1 (entmod (subst (cons 1 (rtos (- cdtk cdtn) 2 3)) (assoc 1 (entget cc)) (entget cc)))
  )
 )
)
(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 dùng cái này. Nó chỉ hỏi 1 lần thôi.

 

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun gan(v l)
   (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
  )
  (if (not laylist)
    (setq laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do thiet ke :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do tu nhien :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Chenh cao :"))) laylist)
    )
  )      
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex
(ssget "X" (list '(0 . "TEXT") (cons 8 (strcat (car laylist)"," (cadr laylist) "," (last laylist))))))))
sstk (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (last laylist))) ss)
sstn (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (cadr laylist))) ss)
sscc (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (car laylist))) ss))
(while sstk
 (setq v (car sstk)
       sstk (cdr sstk)
       cdtk (atof (dxf 1 v))
       tm (gan v sstn)
       cc (gan v sscc))
 (if (and tm cc)
    (setq cdtn (atof (dxf 1 tm))
 sstn (vl-remove tm sstn)
 sscc (vl-remove cc sscc)
 tm1 (entmod (subst (cons 1 (rtos (- cdtk cdtn) 2 3)) (assoc 1 (entget cc)) (entget cc)))
  )
 )
)
(princ)
)

Em cảm ơn anh!

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 dùng cái này. Nó chỉ hỏi 1 lần thôi.

(defun c:cca (/ ss sstk sstn sscc v cdtk tm cc cdtn tm1)
  (defun dxf (id v) (cdr (assoc id (entget v))))
  (defun gan(v l)
   (car (vl-remove-if-not '(lambda(x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l))
  )
  (if (not laylist)
    (setq laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do thiet ke :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Cao do tu nhien :"))) laylist)
 laylist (cons (dxf 8 (car (entsel "\nChon doi tuong thuoc layer Chenh cao :"))) laylist)
    )
  )      
  (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex
(ssget "X" (list '(0 . "TEXT") (cons 8 (strcat (car laylist)"," (cadr laylist) "," (last laylist))))))))
sstk (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (last laylist))) ss)
sstn (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (cadr laylist))) ss)
sscc (vl-remove-if-not '(lambda(x) (= (dxf 8 x) (car laylist))) ss))
(while sstk
 (setq v (car sstk)
       sstk (cdr sstk)
       cdtk (atof (dxf 1 v))
       tm (gan v sstn)
       cc (gan v sscc))
 (if (and tm cc)
    (setq cdtn (atof (dxf 1 tm))
 sstn (vl-remove tm sstn)
 sscc (vl-remove cc sscc)
 tm1 (entmod (subst (cons 1 (rtos (- cdtk cdtn) 2 3)) (assoc 1 (entget cc)) (entget cc)))
  )
 )
)
(princ)
)

Cho em hỏi, em dùng lsp trên rất tốt nhưng có một số bản vẽ lỗi. Anh sửa giúp em được không ạ?

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

Cho em hỏi, em dùng lsp trên rất tốt nhưng có một số bản vẽ lỗi. Anh sửa giúp em được không ạ?

http://www.cadviet.com/upfiles/5/64018_lsp_cc_bi_loi.dwg

Dạo này ít thấy bác Tot77 xuất hiện nhỉ? Bạn ấy tính Tốt cũng như nhiệt tâm về Lisp của nick Tot77 :) .

Chúc bạn Tot77 thành công và đầy sáng tạo trong niềm đam mê của mình :).

Lisp Tot77 chỉ chạy đúng trong điều kiện bản vẽ cụ thể nên bạn đừng thắc mắc kiểu như trên :D .

Trong trường hợp bản vẽ này của bạn thì sữa như sau :

(car (vl-remove-if-not '(lambda (x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l)) thì sửa thành 0.5

  • 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

Dạo này ít thấy bác Tot77 xuất hiện nhỉ? Bạn ấy tính Tốt cũng như nhiệt tâm về Lisp của nick Tot77 :) .

Chúc bạn Tot77 thành công và đầy sáng tạo trong niềm đam mê của mình :).

Lisp Tot77 chỉ chạy đúng trong điều kiện bản vẽ cụ thể nên bạn đừng thắc mắc kiểu như trên :D .

Trong trường hợp bản vẽ này của bạn thì sữa như sau :

(car (vl-remove-if-not '(lambda (x) (< (distance (dxf 10 v) (dxf 11 x)) 1)) l)) thì sửa thành 0.5

Cảm ơn bạn!

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


×