Chuyển đến nội dung
Diễn đàn CADViet
namhai

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

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

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 )

  • 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

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!

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

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

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

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

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

Ý 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

  • 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

 

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

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

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

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

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

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


×