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

[Yêu cầu] viết Lisp dời text về vị trí điểm point gần nhất

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

Tôi còn giữ cái lisp đó, nhưng file dwg để test thì không còn.

 


(defun c:test(/ os ss ss1 ss2 cd) 
  (defun layxy(a) (list (car a) (cadr a)))
  (defun leftL(L n / l1 i) (setq l1 nil i -1) (while (and (< (setq i (1+ i)) n) (nth i L)) (setq l1 (append l1 (list (nth i L))))))
  (defun doi (id tri v)   (entmod (subst (cons id tri) (assoc id (entget v)) (entget v))))
  
  ;;;chuong trinh chinh
  (setq ss (ssget '((0 . "TEXT,POINT")))
ss1 (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "TEXT") (cons (layxy (acet-dxf 11 (entget x))) x) nil)) (acet-ss-to-list ss)))
ss1 (vl-sort (vl-sort ss1 '(lambda(x y) (< (cadar x) (cadar y)))) '(lambda(x y) (< (caar x) (caar y))))
ss2 (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "POINT") (layxy (acet-dxf 10 (entget x))) nil)) (acet-ss-to-list ss)))
ss2 (vl-sort (vl-sort ss2 '(lambda(x y) (< (cadr x) (cadr y)))) '(lambda(x y) (< (car x) (car y))))
  )
  (foreach v ss1    
    (doi 11 (setq cd (car (vl-sort (leftL ss2 10) '(lambda(x y) (< (distance x (car v)) (distance y (car v))))))) (cdr v))
    (setq ss2 (vl-remove cd  ss2))
  )
)

  • 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ôi còn giữ cái lisp đó, nhưng file dwg để test thì không còn.

 


(defun c:test(/ os ss ss1 ss2 cd) 
  (defun layxy(a) (list (car a) (cadr a)))
  (defun leftL(L n / l1 i) (setq l1 nil i -1) (while (and (< (setq i (1+ i)) n) (nth i L)) (setq l1 (append l1 (list (nth i L))))))
  (defun doi (id tri v)   (entmod (subst (cons id tri) (assoc id (entget v)) (entget v))))
  
  ;;;chuong trinh chinh
  (setq ss (ssget '((0 . "TEXT,POINT")))
ss1 (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "TEXT") (cons (layxy (acet-dxf 11 (entget x))) x) nil)) (acet-ss-to-list ss)))
ss1 (vl-sort (vl-sort ss1 '(lambda(x y) (< (cadar x) (cadar y)))) '(lambda(x y) (< (caar x) (caar y))))
ss2 (vl-remove nil (mapcar '(lambda(x) (if (= (acet-dxf 0 (entget x)) "POINT") (layxy (acet-dxf 10 (entget x))) nil)) (acet-ss-to-list ss)))
ss2 (vl-sort (vl-sort ss2 '(lambda(x y) (< (cadr x) (cadr y)))) '(lambda(x y) (< (car x) (car y))))
  )
  (foreach v ss1    
    (doi 11 (setq cd (car (vl-sort (leftL ss2 10) '(lambda(x y) (< (distance x (car v)) (distance y (car v))))))) (cdr v))
    (setq ss2 (vl-remove cd  ss2))
  )
)

Dạ vâng. Em cảm ơn anh. Em xem thuật toán thôi.  :D

Thanks anh 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

Khi viết lisp thì chỉ có thể test trên file chủ thớt đưa, do đó nếu thấy ok thì chỉ ok cho mỗi trường hợp file đó.

Người viết không thể lường hết mọi tình huống xảy ra. Do đó muốn lisp hoàn chỉnh thì phải test trên nhiều file khác nhau thôi bạn ơi. Vì mỗi ngành nghề mổi công ty lại có cách vẽ khác nhau không ai giống ai.

 

Em cũng đang thắc mắc là tại sao chỉ với file đó test dc mà các file khác thì không? Lạ thế?

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

Hoan nghênh!

Thử cái này xem sao.

http://www.cadviet.com/upfiles/3/127168_tmp.lsp

Nhanh hơn cả 2 lisp của DVH và PTB.

Học được 2 điều:

1). Lấy list point chỉ gồm x và y chứ không có z như của tôi. Cái này tăng tốc không nhiều.

2). Dùng vl-sort nhanh hơn foreach. Cái này không ngờ lại tăng tốc đáng kể (srr, tác giả chỉ sort 10 đối tượng).

P/S: Tuy nhiên, 2 hàm sort ss1 và ss2 thì hình như thừa (?)

Bạn Hà có thể post lại lisp này k mình doawnd không được 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


×