Đến nội dung


Hình ảnh
- - - - -

Lisp đánh số thứ tự bản vẽ tự động?


  • Please log in to reply
60 replies to this topic

#41 namtrantt206xd

namtrantt206xd

    biết vẽ circle

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

Đã gửi 03 August 2012 - 01:11 PM

Các bác cho em hỏi: Có ai có lisp mà đánh số thứ tự tăng dần hoặ giảm dần của các điểm trên đường polyline không?EM đang rất cần?
Thanks
  • 0

#42 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 03 August 2012 - 01:35 PM

Tìm trên 4rm này đã có nhiều rồi đó bạn ơi.
  • 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.


#43 namtrantt206xd

namtrantt206xd

    biết vẽ circle

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

Đã gửi 03 August 2012 - 02:28 PM

Tìm trên 4rm này đã có nhiều rồi đó bạn ơi.

Em tìm mãi mà không thấy có, ai biết link không cho em xin vơi?
  • 0

#44 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

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

Đã gửi 03 August 2012 - 04:31 PM

Em tìm mãi mà không thấy có, ai biết link không cho em xin vơi?

Hề hề hề,
1/- Bạn đã tìm thấy cái chi ??? Mình không tin trên diễn đàn chưa co lisp copy tăng dần hay giảm dần. Hãy tìm với từ khóa lisp copy tăng dần. hoặc lisp đánh số thứ tự.
2/- Nếu tất cả các lisp đã có trên diễn đàn chưa đáp ứng đúng yêu cầu của bạn thì hãy gửi cả bản vẽ thể hiện các yêu cầu của bạn lên, có thế mọi người mới biết đường mà giúp.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#45 namtrantt206xd

namtrantt206xd

    biết vẽ circle

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

Đã gửi 04 August 2012 - 12:57 PM

Em đã tìm rồi mà khộng thấy, có lisp copy tăng dần nhưng không phải lisp em cần, ý em là giờ em có 1 đường polyline, em muốn đánh số thứ tự cho các điểm trên đường polyline, chọn được điểm bắt đầu và số bắt đầu ghi. Bác nào có thể giúp em voi?
  • 0

#46 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 04 August 2012 - 01:00 PM

Bạn post bản vẽ lên và thể hiện y/c trên bản vẽ. Nếu chiều nay không ai viết thì tôi sẽ giúp 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.


#47 namtrantt206xd

namtrantt206xd

    biết vẽ circle

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

Đã gửi 04 August 2012 - 01:11 PM

Bạn post bản vẽ lên và thể hiện y/c trên bản vẽ. Nếu chiều nay không ai viết thì tôi sẽ giúp bạn.

ví dụ em có 1 đường pollyline, có 10 điểm chẳng hạn, từ điểm 1 đến điểm 10. giờ em muốn có lisp kiểu như thế này anh ah:
gõ lệnh\ pick vào đường polyline\ chọn điểm bắt đầu đánh số\ chọn số đầu tiên\ chọn bước nhảy.
Bác hiểu ý em không ạ? ví dụ em muốn đánh số cho 10 điểm của đường polyline là từ 1 đến 10, em gõ lệnh, pick vào được polyline\ chọn điểm đầu đường polyline\ nhập 1\ bước nhảy 1. kiểu như thế đấy.
Mong bác giúp được em.hi
  • 0

#48 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 04 August 2012 - 02:43 PM

Quick code. Lần sau bạn nhớ chú ý cách đặt vấn đề và nội quy box này :


(defun c:test(/ i adoc)(vl-load-com)(command "undo" "be")
(setq i -1 a (acet-geom-vertex-list (car (entsel "\nChon Pline :"))))
(mapcar '(lambda(x y)(or (eval x) (set x y))
(set x (cond ((getreal (strcat "\nNhap " (vl-princ-to-string x) ": <" (rtos (eval x) 2 2) ">")))
((eval x))
)
))
'(1st inc h)'(1 1 1))
(mapcar
'(lambda(x)
(vla-addtext
(cond (adoc)
((setq adoc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))
)
(rtos (+ 1st (* (setq i (1+ i)) inc)) 2 0)
(vlax-3d-point x)
h
)
)
(if (wcmatch (getstring "\nGiu nguyen chieu ? <y> ") ",[yY]")
a
(reverse a)
)
)(command "undo" "en")
)

  • 4

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


#49 Doan Van Ha

Doan Van Ha

    biết lệnh adcenter

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

Đã gửi 04 August 2012 - 03:50 PM

Code hay quá Ket ơi!
Tạo object bằng vla-... không cần command undo begin và end, entmake cũng thế (?)
  • 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.


#50 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 04 August 2012 - 04:23 PM

Ketxu gửi cho anh cái tool hoàn thiện của em cho anh nhé. Lần trước em đang viết dở dang ý. Tra cứu mã và có ví dụ đi kèm.
Em gửi vào heaven2407@gmail.com cho anh nhé. Anh sẽ ngâm cứu dần dần và sẽ post trả lời thay các bác cho đỡ mệt (mấy bác Doan Van Ha, Pham Thanh Binh, Nguyen Hoanh, Gia_Bach, .....viết hơi nhiều). Hiiii. Thanks em nhé. HIi
  • 2



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#51 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 04 August 2012 - 05:35 PM

Ketxu gửi cho anh cái tool hoàn thiện của em cho anh nhé. Lần trước em đang viết dở dang ý. Tra cứu mã và có ví dụ đi kèm.
Em gửi vào heaven2407@gmail.com cho anh nhé. Anh sẽ ngâm cứu dần dần và sẽ post trả lời thay các bác cho đỡ mệt (mấy bác Doan Van Ha, Pham Thanh Binh, Nguyen Hoanh, Gia_Bach, .....viết hơi nhiều). Hiiii. Thanks em nhé. HIi

Em sợ a tẩu hỏa mất ^^ Tập trung vào garena đi a ơi :D Tool e vẫn còn n e k viết thêm từ đó đến giờ, để e lục lại nhé. Còn 1 số vấn đề cần nhờ mấy bác bên VB tư vấn nữa nên e chưa viết tiếp đc


Code hay quá Ket ơi!
Tạo object bằng vla-... không cần command undo begin và end, entmake cũng thế (?)


Nếu k mark hoặc begin thì cháu ngờ rằng nó sẽ undo đến bước mark trước đó ^^ (ví dụ vẽ Pline rồi dùng lệnh test -> undo -> hủy luôn cả bước tạo Pline )
  • 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


#52 namtrantt206xd

namtrantt206xd

    biết vẽ circle

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

Đã gửi 04 August 2012 - 07:22 PM

Quick code. Lần sau bạn nhớ chú ý cách đặt vấn đề và nội quy box này :


(defun c:test(/ i adoc)(vl-load-com)(command "undo" "be")
(setq i -1 a (acet-geom-vertex-list (car (entsel "\nChon Pline :"))))
(mapcar '(lambda(x y)(or (eval x) (set x y))
(set x (cond ((getreal (strcat "\nNhap " (vl-princ-to-string x) ": <" (rtos (eval x) 2 2) ">")))
((eval x))
)
))
'(1st inc h)'(1 1 1))
(mapcar
'(lambda(x)
(vla-addtext
(cond (adoc)
((setq adoc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))
)
(rtos (+ 1st (* (setq i (1+ i)) inc)) 2 0)
(vlax-3d-point x)
h
)
)
(if (wcmatch (getstring "\nGiu nguyen chieu ? <y> ") ",[yY]")
a
(reverse a)
)
)(command "undo" "en")
)

Em cảm ơn Bác nhiều nhé, nhưng bác có thể sửa giúp em để cho khi mình chọn đường polyline ở đâu thì text hiện ra ở đó được không? và sửa lại sao cho lisp có thể đánh bắt đầu từ điểm mình pick.
Thanks!
  • 0

#53 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 04 August 2012 - 07:27 PM

K có file miêu tả => Chịu
  • 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


#54 namtrantt206xd

namtrantt206xd

    biết vẽ circle

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

Đã gửi 04 August 2012 - 07:48 PM

K có file miêu tả => Chịu

em mô tả đây bác ah, bác cố gắng giúp em.
  • 0

#55 namtrantt206xd

namtrantt206xd

    biết vẽ circle

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

Đã gửi 04 August 2012 - 07:52 PM

Em cảm ơn Bác nhiều nhé, nhưng bác có thể sửa giúp em để cho khi mình chọn đường polyline ở đâu thì text hiện ra ở đó được không? và sửa lại sao cho lisp có thể đánh bắt đầu từ điểm mình pick.
Thanks!

e

K có file miêu tả => Chịu

em vừa up nhưng chưa được.http://www.cadviet.c...61_drawing1.dwg
  • 0

#56 thanhduan2407

thanhduan2407

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 995 Bài viết
Điểm đánh giá: 223 (khá)

Đã gửi 04 August 2012 - 08:52 PM

Em sợ a tẩu hỏa mất ^^ Tập trung vào garena đi a ơi :D Tool e vẫn còn n e k viết thêm từ đó đến giờ, để e lục lại nhé. Còn 1 số vấn đề cần nhờ mấy bác bên VB tư vấn nữa nên e chưa viết tiếp đc

Gửi cho anh đê. Tẩu hỏa sao được. Hii. VB thì lâu rồi anh cũng chẳng động đến. Thích lisp hơn. Hii
  • 0



Tôi là con kiến bò trên sa mạc kiến thức bao la. Biển học thật rộng lớn







#57 namtrantt206xd

namtrantt206xd

    biết vẽ circle

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

Đã gửi 05 August 2012 - 12:17 PM

không có ai giúp được em sửa lisp kia sao? mọi người giúp em với?
  • 0

#58 ketxu

ketxu

    Copier - Paster - Editor

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

Đã gửi 05 August 2012 - 04:21 PM

Ý 1 : Quick code :


(defun c:test(/ i adoc daolst )(vl-load-com)
(defun daolst (lst p / lst1 i a B)
(setq p (car (vl-sort lst '(lambda(x y)(< (distance p x)(distance p y))))))
(cond
((setq a (member p lst)) (setq i -1)
(setq b (append a
(reverse(repeat (vl-position p lst)
(setq lst1 (cons (nth (setq i (1+ i)) lst) lst1))
))
)))
)
b
)
(command "undo" "be")
(setq i -1 a (acet-geom-vertex-list (car (entsel "\nChon Pline :"))) a (daolst a (getpoint "\nDiem bat dau danh so :")))
(mapcar '(lambda(x y)(or (eval x) (set x y))
(set x (cond ((getreal (strcat "\nNhap " (vl-princ-to-string x) ": <" (rtos (eval x) 2 2) ">")))
((eval x))
)
))
'(1st inc h)'(1 1 1))
(mapcar
'(lambda(x)
(vla-addtext
(cond (adoc)
((setq adoc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))
)
(rtos (+ 1st (* (setq i (1+ i)) inc)) 2 0)
(vlax-3d-point x)
h
)
)
(if (wcmatch (getstring "\nGiu nguyen chieu ? <y> ") ",[yY]")
a
(reverse a)
)
)(command "undo" "en")
)

- Ý 2 của bạn k có cơ sở, vì mình tạo Dtext chứ k tạo Mtext, và mình tạo theo style hiện hành
  • 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


#59 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1436 Bài viết
Điểm đánh giá: 1426 (rất tốt)

Đã gửi 06 August 2012 - 11:08 AM

Nếu có th/giờ, Ket bổ sung thêm t/hợp bản vẽ ở UCS. (chưa đúng vị trí)
  • 2

#60 namtrantt206xd

namtrantt206xd

    biết vẽ circle

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

Đã gửi 07 August 2013 - 05:58 PM

Ý 1 : Quick code :
 

(defun c:test(/ i adoc daolst )(vl-load-com)
(defun daolst (lst p / lst1 i a <img src='http://www.cadviet.com/forum/public/style_emoticons/<#EMO_DIR#>/cool.png' class='bbc_emoticon' alt='B)' />
(setq p (car (vl-sort lst '(lambda(x y)(< (distance p x)(distance p y))))))
(cond
  ((setq a (member p lst)) (setq i -1)  
  (setq b (append a
   (reverse(repeat (vl-position p lst)
	(setq lst1 (cons (nth (setq i (1+ i)) lst) lst1))
   ))
  )))
)
b
)
(command "undo" "be")
(setq i -1 a (acet-geom-vertex-list (car (entsel "\nChon Pline :"))) a (daolst a (getpoint "\nDiem bat dau danh so :")))
(mapcar '(lambda(x y)(or (eval x) (set x y))
(set x (cond ((getreal (strcat "\nNhap " (vl-princ-to-string x) ": <" (rtos (eval x) 2 2) ">")))
((eval x))
   )
))
'(1st inc h)'(1 1 1))
(mapcar
'(lambda(x)
  (vla-addtext
   (cond  (adoc)
((setq adoc (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))))
   )
   (rtos (+ 1st (* (setq i (1+ i)) inc)) 2 0)
   (vlax-3d-point x)
   h
  )
)
(if (wcmatch (getstring "\nGiu nguyen chieu ? <y> ") ",[yY]")
  a
  (reverse a)
)
)(command "undo" "en")
)

- Ý 2 của bạn k có cơ sở, vì mình tạo Dtext chứ k tạo Mtext, và mình tạo theo style hiện hành

Trong lisp này có daolst là gì thế bác nhỉ? vì khi dùng lisp này thì cad báo là  error: no function definition: DAOLST? Bác có cách nào sửa được không?


  • 0