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

[ketxu 2.984]

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 )

[namtrantt206xd 1]

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!

[ketxu 2.984]

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

[namtrantt206xd 1]

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

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

[namtrantt206xd 1]

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.com/upfiles/3/89361_drawing1.dwg

[thanhduan2407 272]

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

[namtrantt206xd 1]

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

[ketxu 2.984]

Ý 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

[gia_bach 1.553]

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

[namtrantt206xd 1]

 

Ý 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?

[nguyenluyen2009 0]

Nhờ các anh em giúp một tay với! em đang sử dụng lisp này, tự nhiên hôm nay bị lỗi

cũng dạng như là đánh điểm tự động:

chọn điểm đầu, điểm kết thúc, chiều cao chữ, khi đánh ra thì chữ cố định là "x", còn số thì tăng dần

Nhờ mọi người kiểm tra hộ vớihttp://www.cadviet.com/upfiles/6/45500_vevt.lsp

[vanduynguyen 2]

Bạn sử dụng Lisp này thử xem :

Cách thức hoạt động tương tự lệnh Array :

Tên lệnh dsbv

http://www.cadviet.com/upfiles/dsbv.vlx

Bác tuệ ơi sao dowload về không đươc bác up lên lại được không bác

[chaykho0908 0]

mình tải được lisp này trên mạng, không rõ của ai làm ra, nhưng giờ muốn sửa lại lisp này từ chỗ chọn đối tượng, khi chọn xong thì số thứ tự nó chạy theo thứ tự mình click chọn, chứ không theo mặc định từ trái sang phải hay từ trên xuống dưới nữa. mong có cao thủ giúp đỡ :(

danh-so-thu-tu-stt.lsp