Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
Người theo dõi 0
vantuan18nd

[Hỏi] đo khoảng cách bằng chỉ bằng 1 lần rê chuột

Bởi vantuan18nd , trong AutoLisp

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

vantuan18nd    5

vantuan18nd
Đã đăng

vn.jpg

Giả sử mình đang cần tìm khoảng cách (phần bôi đen)

Có Lisp nào mà khi quét chọn như hình thì sẽ ra được khoảng cách không ( khoảng cách là 3.58, 2.50, 2.50, 3.58 , như hình)

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

vantuan18nd    5

vantuan18nd
Đã đăng

bạn xem thử cái này.

http://www.cadviet.c...?showtopic=2016

 

Lisp của mình cần cũng tương tự như Link trên .Nhưng thay vì kết quả là tính "Sum" hay "Mul" thì của mình là "khoảng cách" và đối tượng được chọn của mình là Line hoặc Pline chứ không phải là TEXT

( Ý mình là muốn đo khoảng cách giữa các đường màu đỏ, và kết quả mình sẽ chọn Text để ghi thay thế)

Các bác xem và chỉnh sửa hộ nhé !

;;;-----------------------------------------
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
   	(setq e (ssname ss1 i) i (1+ i))
   	(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon cac text can tinh:")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\tChon text ghi ket qua:")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(entmod (subst (cons 1 (rtos kq)) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:MUL( / i m e ss)
(SelData) (setq i 0 m 1.0)
(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) m (* m (atof (cdr (assoc 1 (entget e)))))))
(WriteRes m)
)
;;;-----------------------------------------
(defun C:SUM( / i s e ss)
(SelData) (setq i 0 s 0.0)
(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) s (+ s (atof (cdr (assoc 1 (entget e)))))))
(WriteRes s)
)
;;;-----------------------------------------

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

Doan Van Ha    3.196

Doan Van Ha
Đã đăng

1). Bạn không cần thiết phải gởi 1 lisp khắc hoắc khác huơ với y/c của bạn rồi nhờ sửa.

2). Sau khi có được 4 khoảng cách đó rồi thì sum lại để thay vào 1 text được chọn, hay thay vào 4 text được chọn như hình vẽ?

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

vantuan18nd    5

vantuan18nd
Đã đăng

1). Bạn không cần thiết phải gởi 1 lisp khắc hoắc khác huơ với y/c của bạn rồi nhờ sửa.

2). Sau khi có được 4 khoảng cách đó rồi thì sum lại để thay vào 1 text được chọn, hay thay vào 4 text được chọn như hình vẽ?

Mình trích dẫn góp ý của bạn trước gửi cho link thôi :

Cái mình cần là từng khoảng cách lẻ chứ không phải là Sum hay Mul gì.

Sau khi có khoảng cách đó, nó sẽ hỏi mình chọn text để ghi từng kết quả đó.

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

Doan Van Ha    3.196

Doan Van Ha
Đã đăng

Sau khi có khoảng cách đó, nó sẽ hỏi mình chọn text để ghi từng kết quả đó.

Chọn 1 lần 4 text như ví dụ của bạn rồi tự động ghi lên mỗi text một giá trị khoảng cách thì có tiện hơn không?

  • 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

vantuan18nd    5

vantuan18nd
Đã đăng

Chọn 1 lần 4 text như ví dụ của bạn rồi tự động ghi lên mỗi text một giá trị khoảng cách thì có tiện hơn không?

Đúng ý rồi đấy .Được thế thì còn gì tiện hơ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

phamthanhbinh    3.146

phamthanhbinh
Đã đăng

Đúng ý rồi đấy .Được thế thì còn gì tiện hơn :)

Hề hề hề,

Hãy gửi bản vẽ lên chứ còn gửi nhõn cái hình ấy thì có đúng ý cũng ngồi chờ nhé. Không phải ai cũng làm cái nghề của bạn mà có sẵn các bản vẽ tương tự cái yêu cầu của bạn để test lisp đâu. Không có bản vẽ để test thì cũng như thấy bói xem voi vì ngay như cái text của bạn là Mtext hay Dtext và to nhỏ ra sao, đặt ở đâu cũng là điều cần phải biết mới làm đúng yêu cầu của bạn được bạn ạ.

Đây không phải lần đầu tiên bạn yêu cầu về lisp mà bạn vẫn làm việc kiểu nớ thì ...... Hãy đợi đấy.

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

Doan Van Ha    3.196

Doan Van Ha
Đã đăng

Đúng ý rồi đấy .Được thế thì còn gì tiện hơn :)

Tiện hơn nữa là chỉ cần chọn cả Line và Text chỉ 1 lần. Tuy nhiên, như bác PTB góp ý, là tôi chỉ viết theo ý tưởng đoán mò từ hình vẽ của bạn nhé.

;Cho phep chon tat ca *LINE va *TEXT chi 1 lan.
;Chu y khi chon doi tuong: so *LINE thang dung nhieu hon so *TEXT la 1 doi tuong.
(defun C:HA( / ss lst1 lst2 z kc)
(princ "\nChon cac doi tuong *LINE va *TEXT...")
(setq ss (ssget '((0 . "*LINE,*TEXT"))))
(setq lst1 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (Laydt ss "*LINE")))))
(setq lst2 (vl-remove-if 'listp (mapcar 'cadr (ssnamex (Laydt ss "*TEXT")))))
(setq lst1 (vl-sort lst1 '(lambda (e1 e2) (< (car (cdr (assoc 10 (entget e1)))) (car (cdr (assoc 10 (entget e2))))))))
(setq lst2 (vl-sort lst2 '(lambda (e1 e2) (< (car (cdr (assoc 10 (entget e1)))) (car (cdr (assoc 10 (entget e2))))))))
(cond
 ((/= 1 (- (length lst1) (length lst2)))
  (alert "So *LINE va *TEXT khong phu hop.")
  (exit))
 (T
  (setq z 0)
  (repeat (length lst2)
(setq kc (- (car (cdr (assoc 10 (entget (nth (1+ z) lst1))))) (car (cdr (assoc 10 (entget (nth z lst1)))))))
(entmod (subst (cons 1 (rtos kc 2 2)) (assoc 1 (entget (nth z lst2))) (entget (nth z lst2))))
(setq z (+ z 1))))) )
;-----
(defun Laydt(ss kieu)
(acet-list-to-ss (vl-remove-if '(lambda(x) (null (wcmatch (acet-dxf 0 (entget x)) kieu))) (acet-ss-to-list ss))))

  • 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

qinaide    0

qinaide
Đã đăng

 

Lisp của mình cần cũng tương tự như Link trên .Nhưng thay vì kết quả là tính "Sum" hay "Mul" thì của mình là "khoảng cách" và đối tượng được chọn của mình là Line hoặc Pline chứ không phải là TEXT

( Ý mình là muốn đo khoảng cách giữa các đường màu đỏ, và kết quả mình sẽ chọn Text để ghi thay thế)

Các bác xem và chỉnh sửa hộ nhé !

;;;-----------------------------------------
(defun CheckObj(e MyType) (equal (cdr (assoc 0 (entget e))) MyType))
;;;-----------------------------------------
(defun FilObj(ss1 MyType / ss2 i e)
(setq ss2 (ssadd) i 0)
(repeat (sslength ss1)
   	(setq e (ssname ss1 i) i (1+ i))
   	(if (CheckObj e MyType) (ssadd e ss2) )
)
(eval ss2)
)
;;;-----------------------------------------
(defun SelData( / OK)
(setq OK nil)
(while (not OK)
(prompt "\tChon cac text can tinh:")
(setq ss (FilObj (ssget) "TEXT"))
(if (> (sslength ss) 0) (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
)
;;;-----------------------------------------
(defun WriteRes(kq / OK e data)
(setq OK nil)
(while (not OK)
(setq e (car (entsel "\tChon text ghi ket qua:")))
(if (CheckObj e "TEXT") (setq OK T) (princ "\nDoi tuong chon khong phai text"))
)
(entmod (subst (cons 1 (rtos kq)) (assoc 1 (setq data (entget e))) data))
(princ)
)
;;;-----------------------------------------
(defun C:MUL( / i m e ss)
(SelData) (setq i 0 m 1.0)
(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) m (* m (atof (cdr (assoc 1 (entget e)))))))
(WriteRes m)
)
;;;-----------------------------------------
(defun C:SUM( / i s e ss)
(SelData) (setq i 0 s 0.0)
(repeat (sslength ss) (setq e (ssname ss i) i (1+ i) s (+ s (atof (cdr (assoc 1 (entget e)))))))
(WriteRes s)
)
;;;-----------------------------------------

thank!

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

vantuan18nd    5

vantuan18nd
Đã đăng

Sorry các bác, và cảm ơn vì sự nhiệt tình

- Lisp của bác Hà em gõ lệnh "ha" nó cho chọn Line và Text nhưng enter nó lại báo lỗi : error: no function definition: ACET-SS-TO-LIST . và không dùng được

- Mình Upload file Cad các bạn xem thửhttp://www.cadviet.com/upfiles/3/103675_vdd_1.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

Doan Van Ha    3.196

Doan Van Ha
Đã đăng

Sorry các bác, và cảm ơn vì sự nhiệt tình

- Lisp của bác Hà em gõ lệnh "ha" nó cho chọn Line và Text nhưng enter nó lại báo lỗi : error: no function definition: ACET-SS-TO-LIST . và không dùng được

- Mình Upload file Cad các bạn xem thửhttp://www.cadviet.c...03675_vdd_1.dwg

Bạn hãy cài Tool Express đi. Nếu không cài thì tôi sẽ sửa lại cho 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

ketxu    2.984

ketxu
Đã đăng

Đã cài được Express thì cứ thế mà làm thôi chứ còn gì nữa vantuan ? CHọn 1 loạt Line + Text là xong. Bạn đừng lát một lại post 1 bài như 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

vantuan18nd    5

vantuan18nd
Đã đăng

Mình chạy Express xong rồi làm gì nửa vậy.

gõ lại lênh "ha" của bác Hà , chọn line và text nó vẫn báo : error: no function definition: ACET-SS-TO-LIST

Chắc là không dùng được

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

ketxu    2.984

ketxu
Đã đăng

Quick Modify.

;Cho phep chon tat ca *LINE va *TEXT chi 1 lan.
;Chu y khi chon doi tuong: so *LINE thang dung nhieu hon so *TEXT la 1 doi tuong.Lay khoang cach bang hieu toa do x
;Neu co line nghieng nen chuyen qua vlax-closetpoint
(defun C:HA1( / ss lstLine lstText z dxf ss->list Compare kc)
(princ "\nChon cac doi tuong *LINE va *TEXT...")
(setq  ss (ssget '((0 . "*LINE,*TEXT")))
 dxf   (lambda(id en)(cdr (assoc id (entget en))))
 ss->list  (lambda(ss)(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
 Laydt   (lambda(ss kieu)(vl-remove-if-not '(lambda(x) (wcmatch (dxf 0 x) kieu)) (ss->list ss)))
 Compare  (lambda(a B)(< (car(dxf 10 a))(car(dxf 10 B))))
 lstLine  (vl-sort (Laydt ss "*LINE") 'Compare)
 lstText  (vl-sort (Laydt ss "*TEXT") 'Compare)
)
(cond
((/=  (1- (length lstLine)) (length lstText))
 (alert "So *LINE va *TEXT khong phu hop.")
 (exit))
(T
(setq z 0)
(repeat (length lstText)
 (setq kc (- (car (dxf 10 (nth (1+ z) lstLine))) (car (dxf 10 (nth z lstLine)))))
 (entmod (subst (cons 1 (rtos kc 2 2)) (assoc 1 (entget (nth z lstText))) (entget (nth z lstText))))
 (setq z (1+ z)))
)) )

  • 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

quansla    259

quansla
Đã đăng

Theo mình thì dùng list làm gì, cái đó bạn đo bằng lệnh DLI bình thường sau đó dùng Ctrl+1 cho ẩn toàn bộ (đường gióng, đường ghi kích thước, mũi tên) đi là được, sau đó dùng lệnh "MA" nữa là hoàn hảo, sau này cũng dể đối chiếu, xử lý hơ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

banbe0274    0

banbe0274
Đã đăng

Bác ơi dùng DLI chỉ dùng dóng kích thước từng đoạn một. Em muốn dùng lisp quét 1 lần từ đầu đến cuối là dóng được toàn bộ như hình vẽ.

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
Đăng nhập để thực hiện theo  
Người theo dõi 0
Về Đầu Trang AutoLisp
×