Đến nội dung


Hình ảnh
- - - - -

[Yêu cầu] lisp dãn text trùng nhau trên mặt cắt ngang


  • Please log in to reply
6 replies to this topic

#1 levanhuong1989

levanhuong1989

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 49 (tàm tạm)

Đã gửi 01 May 2014 - 09:13 AM

Chào các bác! Em làm thiết kế đường, trong các mặt cắt ngang khi xuất từ các phần mềm thiết kế ra thì có rất nhiều các nhóm text mà trong mỗi nhóm các text nằm đè nên nhau. Em viết bài nhờ các bác viết giúp em một text để chỉ bằng một lệnh có thể dãn được các text đó với đặc điểm:

- Các nhóm text đã được dóng ngang và đều quay 90 độ ( chỉ cần dãn các text quay 90 độ)

- Dãn text với 1 khoảng cách nhập

- Các text được dãn từ điểm giữa của nhóm text

- Chỉ cần gõ lệnh và chọn vùng, nhập khoảng cách dãn thì sẽ tự động tìm các nhóm text thoả mãn các điều kiện trên

*chi tiết các bác xem giúp em trong bản vẽ đính kèm*

Mong các bác giúp đỡ, với khối lượng mặt cắt ngang lớn, em dùng lisp để chọn từng nhóm text trùng nhau một thì rất mất thời gian.

Cảm ơn các bác.

http://www.cadviet.c...o_viet_lisp.dwg


  • 0

#2 levanhuong1989

levanhuong1989

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 49 (tàm tạm)

Đã gửi 07 May 2014 - 10:11 PM

Hic, em post bài được gần tuần rồi mà không thấy bác nào giúp.

Các bác cố gắng giúp em với. Số lượng text của bọn em chạy ra trùng nhau quá nhiều mà mỗi lần chạy lại thì text lại sắp xếp lại ( lại trùng ) nên rất là vất vả cái công đoạn này.!!!


  • 0

#3 Tot77

Tot77

    biết lệnh adcenter

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

Đã gửi 08 May 2014 - 05:52 PM

Bạn thử dùng cái này. Nếu chạy 1 lần mà vẫn còn có text bị chạm nhau là do trước đó nó cách xa nhau nên nó không nằm trong tập chọn, nhưng sau khi di chuyển tập chọn nó lại đè lên text bên ngoài. Nếu vậy bạn chạy thêm 1 lần nữa là được.

Đây là đề tài không đơn giản, tôi phải nhờ vào hàm express, do đó bạn phải cài express mới chạy được.

 
(defun c:dan (/ )
  (defun tach(l / n l1 l2)
    (setq n 0 l2 nil)
    (repeat (1- (length l))
      (if (not l1) (setq l1 (list (nth n l))))
      (if (< (width (acet-geom-ss-extents (acet-list-to-ss
(mapcar 'cadr (append l1 (list (nth (setq n (1+ n)) l) )))) nil)) (* kcach (1+ (length l1))))
(setq l1 (append l1 (list (nth n l))))
(progn (if (> (length l1) 1) (setq l2 (append l2 (list l1)))) (setq l1 nil))
)
    )
    (if l1 (setq l2 (append l2 (list l1))))
    l2
  )
  (defun width(l) (distance (car l) (list (caadr l) (cadar l) )))
  (defun doi(b kc)
    (vla-put-TextAlignmentPoint (vlax-ename->vla-object b)
(vlax-3d-point (polar ll 0 kc))))
 
  (defun getIP(v)
    (vlax-safearray->list (vlax-variant-value
(vla-get-TextAlignmentPoint (vlax-ename->vla-object v))))
  )
  ;;====================================;;
  
  (vl-load-com)
  (setvar 'dimzin 8)
  
  (setq kcach1 (getreal (strcat "\nNhap khoang cach dan <"
(if kcach (rtos kcach 2 3) (rtos (setq kcach 1) 2 3)) ">:" )))
  (if kcach1 (setq kcach kcach1))
 
  (prompt "\nChon nhom text can sap xep")
  (setq lt (vl-remove-if-not '(lambda(x) (equal (* 0.5 pi)
    (vla-get-rotation (vlax-ename->vla-object x )) 0.001))
(acet-ss-to-list (ssget '((0 . "text"))))))
  (acet-tjust (setq ss (acet-list-to-ss lt)) (acet-tjust-keyword (entget (ssname ss 0))))
  
  (setq lt (mapcar '(lambda(x) (list (getIP x) x)) lt)
lt (vl-sort lt '(lambda (x y) (>= (cadar x) (cadar y))))
  )  
  
  (while lt
    (setq lt1 (vl-sort (vl-remove-if-not '(lambda(x) (equal (cadar x) (cadar (car lt)) kcach)) lt)
  '(lambda (x y) (< (caar x) (caar y))))
 lt  (vl-remove-if '(lambda(x) (equal (cadar x) (cadar (car lt)) kcach)) lt)
 lt1 (tach lt1)
    )
    
    (foreach lv lt1
      (setq slv (mapcar 'cadr lv)
   n0 (fix (* 0.5 (length slv)))
   ll (getIP (nth n0 slv))
            k 0)
      (while (>= (setq n (- n0 (setq k (1+ k)))) 0)
(doi (nth n slv) (* k (- kcach))))
      (setq k 0)
      (while (< (setq n (+ n0 (setq k (1+ k)))) (length slv))
(doi (nth n slv) (* k kcach))) 
    )
  )
  (princ)
)
 


  • 2

#4 huunhantvxdts

huunhantvxdts

    biết dimbaseline

  • Members
  • PipPipPipPipPip
  • 366 Bài viết
Điểm đánh giá: 53 (tàm tạm)

Đã gửi 09 May 2014 - 07:36 AM

Không biết thiếu cái gì mà chạy thấy lỗi như sau:

bad argument type: <Entity name: 7cf14d48>

Bạn xem lại dùm

.

.

.

Đã tìm ra lỗi do download về nó tự thêm vào mấy kí tự ở dòng này

(setq<span> </span>lt (mapcar '(lambda(x) (list (getIP x) x)) lt)


  • 0

#5 levanhuong1989

levanhuong1989

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 49 (tàm tạm)

Đã gửi 11 May 2014 - 03:02 PM

Bạn thử dùng cái này. Nếu chạy 1 lần mà vẫn còn có text bị chạm nhau là do trước đó nó cách xa nhau nên nó không nằm trong tập chọn, nhưng sau khi di chuyển tập chọn nó lại đè lên text bên ngoài. Nếu vậy bạn chạy thêm 1 lần nữa là được.

Đây là đề tài không đơn giản, tôi phải nhờ vào hàm express, do đó bạn phải cài express mới chạy được.

 
(defun c:dan (/ )
  (defun tach(l / n l1 l2)
    (setq n 0 l2 nil)
    (repeat (1- (length l))
      (if (not l1) (setq l1 (list (nth n l))))
      (if (< (width (acet-geom-ss-extents (acet-list-to-ss
(mapcar 'cadr (append l1 (list (nth (setq n (1+ n)) l) )))) nil)) (* kcach (1+ (length l1))))
(setq l1 (append l1 (list (nth n l))))
(progn (if (> (length l1) 1) (setq l2 (append l2 (list l1)))) (setq l1 nil))
)
    )
    (if l1 (setq l2 (append l2 (list l1))))
    l2
  )
  (defun width(l) (distance (car l) (list (caadr l) (cadar l) )))
  (defun doi(b kc)
    (vla-put-TextAlignmentPoint (vlax-ename->vla-object B)
(vlax-3d-point (polar ll 0 kc))))
 
  (defun getIP(v)
    (vlax-safearray->list (vlax-variant-value
(vla-get-TextAlignmentPoint (vlax-ename->vla-object v))))
  )
  ;;====================================;;
  
  (vl-load-com)
  (setvar 'dimzin 8)
  
  (setq kcach1 (getreal (strcat "\nNhap khoang cach dan <"
(if kcach (rtos kcach 2 3) (rtos (setq kcach 1) 2 3)) ">:" )))
  (if kcach1 (setq kcach kcach1))
 
  (prompt "\nChon nhom text can sap xep")
  (setq lt (vl-remove-if-not '(lambda(x) (equal (* 0.5 pi)
    (vla-get-rotation (vlax-ename->vla-object x )) 0.001))
(acet-ss-to-list (ssget '((0 . "text"))))))
  (acet-tjust (setq ss (acet-list-to-ss lt)) (acet-tjust-keyword (entget (ssname ss 0))))
  
  (setq lt (mapcar '(lambda(x) (list (getIP x) x)) lt)
lt (vl-sort lt '(lambda (x y) (>= (cadar x) (cadar y))))
  )  
  
  (while lt
    (setq lt1 (vl-sort (vl-remove-if-not '(lambda(x) (equal (cadar x) (cadar (car lt)) kcach)) lt)
  '(lambda (x y) (< (caar x) (caar y))))
 lt  (vl-remove-if '(lambda(x) (equal (cadar x) (cadar (car lt)) kcach)) lt)
 lt1 (tach lt1)
    )
    
    (foreach lv lt1
      (setq slv (mapcar 'cadr lv)
   n0 (fix (* 0.5 (length slv)))
   ll (getIP (nth n0 slv))
            k 0)
      (while (>= (setq n (- n0 (setq k (1+ k)))) 0)
(doi (nth n slv) (* k (- kcach))))
      (setq k 0)
      (while (< (setq n (+ n0 (setq k (1+ k)))) (length slv))
(doi (nth n slv) (* k kcach))) 
    )
  )
  (princ)
)
 

 

Cảm ơn bác đã quan tâm. Em đã copy lisp về và chạy thử trên cad 2008, 2013 thì đều xuất hiện lỗi tương tự nhau:

"  Chon nhom text can sap xep
Select objects: Specify opposite corner: 392 found

Select objects:  ; error: bad argument type: <Entity name: 7ed79860>    "

Mong bác sửa lỗi giúp để lisp hoạt động tốt, Máy em đã cài express bác nhé.

Cảm ơn bác.


  • 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 11 May 2014 - 03:14 PM

Lỗi đó không phải do lisp mà do down theo dạng như #3 bị chèn thêm nhiều ký tự lạ làm lisp bị lỗi.

Bạn down lại theo link này.

http://www.mediafire...ada/Dan_chu.lsp


  • 1

#7 levanhuong1989

levanhuong1989

    biết vẽ circle

  • Members
  • PipPip
  • 32 Bài viết
Điểm đánh giá: 49 (tàm tạm)

Đã gửi 11 May 2014 - 05:16 PM

Lỗi đó không phải do lisp mà do down theo dạng như #3 bị chèn thêm nhiều ký tự lạ làm lisp bị lỗi.

Bạn down lại theo link này.

http://www.mediafire...ada/Dan_chu.lsp

Cảm ơn bác, em dowload về theo link này thì lisp đã chạy ok rùi.

Cảm ơn bácTot77 cùng các bác trên diễn đàn đã giúp đỡ.


  • 0