Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
34 replies to this topic

#1 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 24 May 2012 - 01:01 PM

Hình đã gửi
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)
  • 0

#2 master_worse

master_worse

    biết lệnh offset

  • Advance Member
  • PipPipPip
  • 170 Bài viết
Điểm đánh giá: 87 (tàm tạm)

Đã gửi 24 May 2012 - 01:14 PM

bạn xem thử cái này.
http://www.cadviet.c...?showtopic=2016
  • 1

Ngu dốt không đáng thẹn bằng thiếu ý chí học hỏi


Tri thức làm người ta khiêm tốn, ngu si làm người ta kiêu ngạo (Ngạn ngữ Anh)


#3 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 24 May 2012 - 01:32 PM

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)
)
;;;-----------------------------------------

  • 0

#4 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 24 May 2012 - 01:47 PM

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ẽ?
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#5 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 24 May 2012 - 01:57 PM

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ả đó.
  • 0

#6 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 24 May 2012 - 02:15 PM

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?
  • 1

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#7 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 24 May 2012 - 02:21 PM

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 :)
  • 0

#8 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6007 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 24 May 2012 - 02:28 PM

Đú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.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#9 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 24 May 2012 - 03:15 PM

Đú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))))

  • 2

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#10 qinaide

qinaide

    Chưa sử dụng CAD

  • Members
  • Pip
  • 2 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 25 May 2012 - 08:34 AM


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!
  • 0
Hình đã gửi

#11 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 May 2012 - 08:31 AM

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
  • 0

#12 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 5447 Bài viết
Điểm đánh giá: 2624 (tuyệt vời)

Đã gửi 27 May 2012 - 08:33 AM

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.
  • 0

* Chỉ nên yêu cầu Lisp khi bạn làm việc đó mất cả ngày nhưng họ chỉ viết 1 giờ. Đừng nêu yêu cầu Lisp khi bạn chỉ làm 1 giờ nhưng bắt họ phải mất cả ngày.

* Nhờ viết lisp cũng như đi khám bệnh. Chỉ gởi căn cước và than sắp chết thì không bác sỹ nào cứu sống được.


#13 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 May 2012 - 08:40 AM

Mình tải trên mạng về hay sao hả bạn.
Máy mình không có cái đó
  • 0

#14 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 May 2012 - 09:00 AM

Em cài được Express rồi.
  • 0

#15 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 May 2012 - 10:28 AM

bác sửa lại lisp hay chỉ e cách làm đi
  • 0

#16 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 May 2012 - 10:42 AM

Đã 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ế :)
  • 0

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#17 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 May 2012 - 10:50 AM

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
  • 0

#18 ketxu

ketxu

    Copier - Paster - Editor

  • Moderator
  • PipPipPipPipPipPipPip
  • 5678 Bài viết
Điểm đánh giá: 2605 (tuyệt vời)

Đã gửi 27 May 2012 - 11:09 AM

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)))
)) )

  • 1

Thành viên nhóm CadMagic.
Mời bạn ghé thăm facebook nhóm - Page viết lisp theo yêu cầu  :
CAD MAGIC


#19 vantuan18nd

vantuan18nd

    biết vẽ rectang

  • Members
  • PipPip
  • 83 Bài viết
Điểm đánh giá: -3 (bình thường)

Đã gửi 27 May 2012 - 11:18 AM

ok. mình dùng được rồi.Thanks
  • 0

#20 banbe0274

banbe0274

    biết vẽ pline

  • Members
  • PipPip
  • 66 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 19 January 2013 - 11:05 AM

Nhờ các Bác viết lisp quét toàn bộ line như hình trên cho ra kết quả kich thước như hình trên.

Sao không up được file lên nhỉ
  • 0