[Nhờ viết lisp]Rải và đánh số thứ tự cọc

[harrypotter2007 1]

Mình cần rải cọc và đánh số thứ tự cọc theo hướng nhất định.(zigzag hoặc xoắn ốc chẳng hạn)Mình đã thủ dùng tcount nhưng không được như ý.Không biết bạn nào biết làm hay đã có lisp sẵn gửi cho mình.Cám ơn các bạn đã đọc!

[Luxury037 39]

Mình cần rải cọc và đánh số thứ tự cọc theo hướng nhất định.(zigzag hoặc xoắn ốc chẳng hạn)Mình đã thủ dùng tcount nhưng không được như ý.Không biết bạn nào biết làm hay đã có lisp sẵn gửi cho mình.Cám ơn các bạn đã đọc!

Cái này Lisp Copy Text tăng hoặc giảm làm được đó bạn.

Bạn dùng tạm cái này của Mem trên cadviet nhé:

 

(defun C:CT (/ name_op num_op_chon point_base_st point_new_st num_ op_tang
             	op_tang_new last_ch cong_val)
(setq old_ts_err *error*)
(setvar "Cmdecho" 0)
(if(= cong_vao NIL)(setq cong_vao 1))
(Prompt "\n Neu tham so < 0  --> ket qua giam ! ")
(setq cong_val(getint(strcat "\n Tham so tang /<" (itoa cong_vao)">: ") ))
 	(if(= cong_val NIL)(setq cong_val cong_vao)(setq cong_vao cong_val))
(Prompt "\n Chon doi tuong tang: ")
(if(and cong_vao (setq op_tang(ssget)))
  (progn
(setq num_op_chon(sslength op_tang)
     	num_ 0
     	op_tang_new NIL)
(if(setq point_base_st(getpoint "\n > Diem goc: "))
  	(while
  	(setq point_new_st(getpoint "\n >> Diem dat tiep theo: " point_base_st))
     	(if op_tang_new (setq op_tang op_tang_new op_tang_new NIL))
     	(setq num_op_chon(sslength op_tang) op_tang_new(ssadd))
     	(if(and point_base_st point_new_st)
        	(progn
         	(repeat num_op_chon
           	(progn
              	(setq name_op(ssname op_tang num_))
              	(command "_.Copy" name_op "" point_base_st point_new_st)
	(setq last_ch(entlast)
                    	op_tang_new(ssadd last_ch op_tang_new))
              	(process)
              	(setq num_ (+ 1 num_))
                	(if(= num_ num_op_chon)(setq num_ 0))
           	)
         	)
        	)
     	);if
     	(setq point_base_st point_new_st)
  	));if while
  );progn
);if 
(setq *error* old_ts_err)
(princ)
);End Tang.
(defun process (/ name_check text_value dat_up dat_style num_value new_value)
(progn
         	(setq name_check(assoc 0 (setq dat_up (entget last_ch))) )
         	(if(or(= (cdr name_check) "TEXT")
               	(= (cdr name_check) "MTEXT"))
            	(progn
              	(setq text_value(assoc 1 dat_up))
              	(if(= (distof (cdr text_value) 2) NIL)
                 	(setq dat_style "Text")
                 	(setq dat_style "Num" num_value (atof (cdr text_value)) )
              	)
              	(cond
                 	((= dat_style "Num")
                  	(setq new_value (itoa (fix(+ num_value cong_vao))) ))
                 	((= dat_style "Text")
                  	(setq new_value(chr (+ (ascii (cdr text_value)) cong_vao))) )
              	)
              	(setq dat_up(subst (cons '1 new_value) text_value dat_up) )
              	(entmod dat_up)
            	);progn
         	);if
         	(setq name_op NIL)
);progn
);Process.

[phamthanhbinh 3.146]

Mình cần rải cọc và đánh số thứ tự cọc theo hướng nhất định.(zigzag hoặc xoắn ốc chẳng hạn)Mình đã thủ dùng tcount nhưng không được như ý.Không biết bạn nào biết làm hay đã có lisp sẵn gửi cho mình.Cám ơn các bạn đã đọc!

 

Hề hề hề,

Với cái yêu cầu thế này thì có nhẽ bạn sẽ phải chờ lâu mới có cái bạn cần bạn ạ.

Muốn gì thì bạn phải post bản vẽ có cái dầu vào đầu ra rõ ràng chứ xem cái ảnh mờ mờ ảo ảo, nhìn toét cả mắt mà chả thấy rõ hơn cái yêu cầu của bạn thì xin thua. Có muốn cũng chả giúp nổi chứ nói chi đến không muốn.

Hề hề hề.

hãy đọc kỹ các yêu cầu về việc post bài trong box này bạn nhé.

[harrypotter2007 1]

^^!Lần đầu tham gia diễn đàn nên không rành lắm.Mình xin trình bày lại nhé.Trước tiên mình có 1 mặt bằng để cắm cọc.Trình tự công việc và cách mình thực hiện :

- Mình dùng lệnh array rải cọc lên mặt bằng

-Đánh số thứ tự cho từng cọc theo 1 nguyên tắc nhất định (zigzag hoặc hình xoắn ốc)

-Dùng lệnh ID lấy tọa độ tương ứng với số thứ tự mình vừa đánh.

http://www.cadviet.com/upfiles/3/103076_rai__danh_so_thu_tu_coc.dwg

Mình vẽ bình thường bằng nét vẽ mặc định và chụp hình màn hình rối up lên photobuket.Không biết chỉnh và chọn màu sao cho nhìn rõ hình.Mình có up file lên rồi.Có gì mong mọi người bỏ qua và chỉ mình cách post bài sao cho hiểu quả.Mình đã đọc các hướng dẫn của diễn đàn và làm theo.Mọi người có cách nào làm những công viêc mình vừa nêu nhanh chóng thì chỉ mình với nhé.Cám ơn mọi người đã chia sẻ!

[ketxu 2.984]

Hãy tạo cọc là những Block ATT thì các thao tác tiếp theo của người viết lisp sẽ dễ dàng hơn

[phamthanhbinh 3.146]

^^!Lần đầu tham gia diễn đàn nên không rành lắm.Mình xin trình bày lại nhé.Trước tiên mình có 1 mặt bằng để cắm cọc.Trình tự công việc và cách mình thực hiện :

- Mình dùng lệnh array rải cọc lên mặt bằng

-Đánh số thứ tự cho từng cọc theo 1 nguyên tắc nhất định (zigzag hoặc hình xoắn ốc)

-Dùng lệnh ID lấy tọa độ tương ứng với số thứ tự mình vừa đánh.

 

http://www.cadviet.c..._thu_tu_coc.dwg

Mình vẽ bình thường bằng nét vẽ mặc định và chụp hình màn hình rối up lên photobuket.Không biết chỉnh và chọn màu sao cho nhìn rõ hình.Mình có up file lên rồi.Có gì mong mọi người bỏ qua và chỉ mình cách post bài sao cho hiểu quả.Mình đã đọc các hướng dẫn của diễn đàn và làm theo.Mọi người có cách nào làm những công viêc mình vừa nêu nhanh chóng thì chỉ mình với nhé.Cám ơn mọi người đã chia sẻ!

Hề hề hề,

Trong lúc chờ đợi cái mới hay hơn, nếu bạn array theo lưới ô vuông như file bạn đã gửi thì có thể sử dụng cái lisp Tcount mà bạn có bằng cách hãy tạo một pline nối các điểm chèn của block mà bạn sẽ array ra rồi dùng lệnh với bước chèn block là bước aray bạn ạ.

Do cái quy luật của bạn đưa ra hơi nhiều nên việc làm lisp cho đúng các quy luật này cũng là một điều phải nghĩ, chứ không phải có ngay được, mong bạn thông cảm với những người viết lisp bạn nhé.

[phamthanhbinh 3.146]

^^!Lần đầu tham gia diễn đàn nên không rành lắm.Mình xin trình bày lại nhé.Trước tiên mình có 1 mặt bằng để cắm cọc.Trình tự công việc và cách mình thực hiện :

- Mình dùng lệnh array rải cọc lên mặt bằng

-Đánh số thứ tự cho từng cọc theo 1 nguyên tắc nhất định (zigzag hoặc hình xoắn ốc)

-Dùng lệnh ID lấy tọa độ tương ứng với số thứ tự mình vừa đánh.

 

http://www.cadviet.c..._thu_tu_coc.dwg

Mình vẽ bình thường bằng nét vẽ mặc định và chụp hình màn hình rối up lên photobuket.Không biết chỉnh và chọn màu sao cho nhìn rõ hình.Mình có up file lên rồi.Có gì mong mọi người bỏ qua và chỉ mình cách post bài sao cho hiểu quả.Mình đã đọc các hướng dẫn của diễn đàn và làm theo.Mọi người có cách nào làm những công viêc mình vừa nêu nhanh chóng thì chỉ mình với nhé.Cám ơn mọi người đã chia sẻ!

Hề hề hề,

Bạn dùng thử cái lisp này xem sao nhé. Mình viết nó cho hai trường hợp: 1 là đánh số theo đường ziczac từ trái qua phải và bắt đầu từ góc dưới bên trái, 2 là đánh số theo đường xoắn trôn ốc theo chiều kim đồng hồ bắt đầu từ góc dưới bên trái.

Cả hai trường hợp này đều sử dụng cho việc array theo dạng lưới ô vuông (khoảng cách cột và khoảng cách hàng là bằng nhau.

Các trường hợp khác bạn có thể tự bổ sung dựa trên cái lisp này nhé (tỷ như xoắn theo ngược chiều kim đồng hồ hay ziczac từ phải qua trái, từ trên xuống dưới.....).

Hiện mình chưa làm tca1ch đánh số theo đường xoắn từ trong ra ngoài do mình chưa hiểu cách chọn điểm bắt đầu đánh số của bạn. Nếu điểm này là bất kỳ thì không hề dễ dàng chút nào bạn ạ, vì khi đó có thể cái đường xoắn nó không thể chạy hết vùng bạn muốn. Rất mong bạn nói rõ mới được.

Hãy dùng thử và ch ý kiến nhé.

(defun c:rvds (/ a b c p bl pa i p1 p2 p3 p4 p5 en ent el ssl elst j pb pb1 pb2 pb3 pb4 pb5 x y)
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq a (getreal "\n Nhap buoc aray: ")
         b (getint "\n Nhap so hang : ")
         c (getint "\n Nhap so cot: ")
         p (getpoint "\n Nhap diem bat dau aray")
         bl (cdr (assoc 2 (entget (car (entsel "\n Chon block can array")))))
)
(setq pa (getstring t "\n Chon phuong an danh so < A, B, C>: "))
(cond
     ((= (strcase pa) "A")
      	(setq i 1)
      	(command "pline" p (setq p1 (polar p (* 0.5 pi) (* a (1- B)))))
      	(while (< i c)
              	(command p1 (setq p2 (polar p1 0 a)) )
              	(if (/= (rem i 2) 1)
                  	(command (setq p3 (polar p2 (* 0.5 pi) (* a (1- B)))) )
                  	(command (setq p3 (polar p2 (* 1.5 pi) (* a (1- B)))) )
              	)
              	(setq p1 p3 i (1+ i))
      	)
      	(command "")
  	)
  	((= (strcase pa) "B")
        	(command "pline")
        	(while (and (> b 2) (> c 2))
                     (command p (setq p1 (polar p (* 0.5 pi) (* a (1- B)))) (setq p2 (polar p1 0 (* a (1- c))))
                                    	(setq p3 (polar p2 (* 1.5 pi) (* a (1- B)))) (setq p4 (polar p3  pi (* a (- c 2)))) (setq p5 (polar p4 (* 0.5 pi)  a)) )
                     (setq b (- b 2) c (- c 2) p p5)
        	)
        	(if (> b 1)
            	(if (< c 2)
            	(command p (polar p (* 0.5 pi) (* a (1- B))))
            	(command p (setq p1 (polar p (* 0.5 pi) (* a (1- B)))) (setq p2 (polar p1 0 (* a (1- c))))
                                       (setq p3 (polar p2 (* 1.5 pi) (* a (1- B)))) (setq p4 (polar p3  pi (* a (- c 2)))) )
            	)
        	)
        	(if (and (> c 1) (= b 1))
            	(command p (polar p 0 (* a (1- c))))
        	)
        	(command "")
  	)

  	(T nil)
)

(setq en (entlast))
(command "measure" en "b" bl "y" a)
(setq ssl (acet-ss-to-list (setq ss (ssget "p"))))
(command "insert" bl (vlax-curve-getstartpoint en) 1 "" "")
(setq ssl (cons (entlast) ssl))
(command "insert" bl (vlax-curve-getendpoint en) 1 "" "")
(setq ssl (append ssl (list (entlast))))
(setq elst (list))
(foreach ent ssl
	(setq elst (append elst (list (list ent (cdr (assoc 10 (entget ent)))))))
)
(setq elst (vl-remove-if '(lambda (x) (equal (cadr x) (cadr (nth (1+ (vl-position x elst)) elst)) 0.01) ) elst))
(setq pb (list (+ (car p) (* a (+ 5 c))) (+ (cadr p) (* a B)))
    	pb1 (polar pb 0 600)
    	pb2 (polar pb1 (* 1.5 pi) (* (+ (length elst) 2) 50))
    	pb3 (polar pb2 pi 600)
    	pb4 (list (+ (car pb) 200) (- (cadr pb) 100))
    	pb5 (list (+ (car pb) 200) (- (cadr pb) 50))
)
(command "line" pb pb1 pb2 pb3 "c")
(command "line" pb pb4 "")
(command "line" pb5 (polar pb5 0 400) "")
(command "line" (polar pb 0 200) (list (+ (car pb) 200) (- (cadr pb) (* (+ (length elst) 2) 50))) "")
(command "line" (polar pb 0 400) (list (+ (car pb) 400) (- (cadr pb) (* (+ (length elst) 2) 50))) "")
(styleset)
(command "text" "j" "mc" (list (+ (car pb) 150) (- (cadr pb) 25)) 16 0 "Toïa ñoä")
(command "text" "j" "mc" (list (+ (car pb) 50) (- (cadr pb) 75)) 16 0 "Soá thöù töï")
(command "text" "j" "mc" (list (+ (car pb) 300) (- (cadr pb) 25)) 16 0 "X")
(command "text" "j" "mc" (list (+ (car pb) 500) (- (cadr pb) 25)) 16 0 "Y")
(command "text" "j" "mc" (list (+ (car pb) 300) (- (cadr pb) 75)) 16 0 "(m)")
(command "text" "j" "mc" (list (+ (car pb) 500) (- (cadr pb) 75)) 16 0 "(m)")

(setq j 1)
(foreach el elst
  	(setq x (rtos (caadr el) 2 3) y (rtos (cadadr el) 2 3))
  	(command "line" (list (car pb) (- (cadr pb) (* (1+ j) 50))) (list (+ (car pb) 600) (- (cadr pb) (* (1+ j) 50))) "")
  	(command "text" "j" "mc" (list (+ (car pb) 100) (- (cadr pb) 25 (* (1+ j) 50))) 16 0 (rtos j 2 0))
  	(command "text" "j" "mc" (list (+ (car pb) 300) (- (cadr pb) 25 (* (1+ j) 50))) 16 0 x)
  	(command "text" "j" "mc" (list (+ (car pb) 500) (- (cadr pb) 25 (* (1+ j) 50))) 16 0 y)
  	(command "text" "j" "mc" (list (caadr el)  (+ (cadadr el) 25)) 16 0 (rtos j 2 0))
  	(setq j (1+ j))
)
(setvar "osmode" oldos)
(command "undo" "e")
(princ)
)

(defun styleset (/ stl h)
(setq stl (getvar "textstyle")
    	h (getvar "textsize"))
(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))
)            

Chúc bạn vui

[amateurday 16]

Nhờ bác Bình viết lại lisp này với Block att (block att đã được tạo sẵn trên bản vẽ) và hàm entmake (thay cho lệnh insert) được không.

[phamthanhbinh 3.146]

Nhờ bác Bình viết lại lisp này với Block att (block att đã được tạo sẵn trên bản vẽ) và hàm entmake (thay cho lệnh insert) được không.

Hề hề hề,

Thú thực là cái hàm entmake mình dùng không tốt lắm do chưa hiểu rõ lắm. Nhưng nếu bạn muốn thì mình sẽ thử. Tuy nhiên bạn cần nói rõ hơn về cái block thuộc tính của bạn. Nó có bao nhiêu thuộc tính và bạn cần thay đổi các thuộc tính đó ra sao mình mới biết chỗ lần mò chứ. Cách tốt nhất là bạn hãy upload cái bản vẽ thể hiện yêu cầu trước và sau khi dùng lisp để mình tiện đối chiếu và test mới có thể đáp ứng được yêu cầu của mình.

Rút kinh nghiệm của nhiều người hỏi không rõ ràng nên người làm lisp ra mất công mà chả được việc gì bạn ạ. Đã vậy lại còn phát sinh thêm nhiều sự hiểu lầm không đáng có nữa.

bạn cũng cần lưu ý thêm là cái lisp trên mình dùng lệnh measure nên các khoảng cách giũa các cột và các hàng phải giống nhau,(cái này là mình dựa trên yêu cầu của chủ thớt). Trong trường hợp chúng khác nhau thì lisp sẽ chạy sai đấy. Vì thế bạn nên nói rõ yêu cầu của bạn vì có thể bạn sẽ cần array với khoảng cách cột và dòng khác nhau. Trường hợp đó mình sẽ phải áp dụng giải pháp khác với lisp trên.

Hề hề hề....

[amateurday 16]

Nhờ bác giúp mà quên không up lên, thật là ngại quá. Nay nhờ bác ghé qua thăm topic tí nhé. Att nào thay đổi thì mình sẽ chọn, trong trường hợp này là Att1. Chờ tin bác

phamthanhbinh và các bác cadviet nhé!!!

 

http://www.cadviet.com/upfiles/3/32649_103076_rai__danh_so_thu_tu_coc.dwg

[lp_hai 225]

Xin các bác thứ lỗi em bon chen chút xíu nhá,

Bạn Amateurday cho mình hỏi là file bố trí cọc của bạn có đi kèm theo cái bản ID ko? và khi bạn vẽ Cọc có chính xác tọa độ cọc theo cái bảng đó?

Lúc này sẽ dễ dàng hơn cho việc đánh số, vì lisp có thể làm việc dựa trên dữ liệu mà cái bảng ID kia liệt kê, ko cần phải khai báo kiểu hướng đi từ cọc 1 đến các cọc tiếp theo theo hình xoắn ốc hay hình Zizac, cũng ko phụ thuộc vào khoảng cách các block...

 

Nếu tọa độ cọc chính xác thì cứ dựa vào điểm chèn của block trong bảng mà đánh số.

Nếu chỉ là "tọa độ tương đối" thì dịch cái toạn độ tương đối này về tọa độ tuyệt đối rồi đánh số.

 

Tấc nhiên là sẽ mệt hơn chon người viết lisp, nhưng bù lại nó chạy chính xác và dễ sữ dụng hơn.

 

Vài lời góp ý!!! :)

[amateurday 16]

Yêu cầu của mình là tiếp theo bạn Harrypotter2007 thôi. Bảng id xuất hiện sau khi chèn cọc ấy chứ, tọa độ thì tương đối hay tuyệt đối cũng được, sau khi đưa qua excel thì +,-,*,/ cho ra tọa độ thật cũng được mà.

[lp_hai 225]

Yêu cầu của mình là tiếp theo bạn Harrypotter2007 thôi. Bảng id xuất hiện sau khi chèn cọc ấy chứ, tọa độ thì tương đối hay tuyệt đối cũng được, sau khi đưa qua excel thì +,-,*,/ cho ra tọa độ thật cũng được mà.

hihi đúng là e hơi hồ đồ, nhưng mình vẫn hơi thắc mắc một chút!

sau khi có lisp đánh số rồi thì bạn lấy cái bản ID bằng cách nào? dựa vào lisp khi nảy để lấy hay là dùng lệnh id rồi kick vào từng block???

Nếu dc các bác kia viết thêm cho cái đoạn code để tự động chuyển tọa độ ra bảng thì hay quá, còn nếu cứ phải kick thủ công (khi dùng lệnh ID hoặc phải vẽ cái PLine đường dẫn) như bạn Harry ban đầu yêu cầu thì dùng lisp copy tăng dần hoặc sửa số tăng dần thì sao? Có đơn giản mà chắc ăn hơn ko?

[amateurday 16]

Lấy bảng tọa độ thì tận dụng luôn code trong lisp luôn chứ. Nói chung lisp trên ok rồi, mình chỉ muốn bác ấy viết thêm bằng lệnh entmake để mình học hỏi thêm thôi. Dùng entmake thì lisp có vẻ gọn hơn, có thể tùy chỉnh, tạo block att tiện hơn. Bản vẽ dùng block att thì rõ ràng hơn so với bản vẽ nhiều text chứ nhỉ???

[ketxu 2.984]

Lấy bảng tọa độ thì tận dụng luôn code trong lisp luôn chứ. Nói chung lisp trên ok rồi, mình chỉ muốn bác ấy viết thêm bằng lệnh entmake để mình học hỏi thêm thôi. Dùng entmake thì lisp có vẻ gọn hơn, có thể tùy chỉnh, tạo block att tiện hơn. Bản vẽ dùng block att thì rõ ràng hơn so với bản vẽ nhiều text chứ nhỉ???

Nhu cầu k hợp lý với tần suất lao động vì anh em của bác Bình ! Nếu bạn đã biết lisp rồi thì hãy chuyển sang các mục hỏi về lisp

[phamthanhbinh 3.146]

Lấy bảng tọa độ thì tận dụng luôn code trong lisp luôn chứ. Nói chung lisp trên ok rồi, mình chỉ muốn bác ấy viết thêm bằng lệnh entmake để mình học hỏi thêm thôi. Dùng entmake thì lisp có vẻ gọn hơn, có thể tùy chỉnh, tạo block att tiện hơn. Bản vẽ dùng block att thì rõ ràng hơn so với bản vẽ nhiều text chứ nhỉ???

Hề hề hề,

Bạn dùng thử cái này coi có ưng ý không nhé.

Mình sử dụng cái đoạn lisp enmake block thuộc tính của bác thaistreet. (chứ cái vụ này mình chưa rành rẽ lắm). Hãy nhớ cảm ơn bác ấy nếu bạn thấy hài lòng

Phần còn lại là mình xào nấu từ cái lisp cũ đã viết. Sở dĩ hơi lâu vì mình phải mò mẫm cái của bác Thái cho nó thung thủng rồi mới dám xài. Tuy vậy cũng có thể có những điểm mà mình chưa hiểu hết nên không khai thác triệt để được, mong bạn thông cảm.

Lisp này có tiến bộ hơn lisp trước ở chỗ bạn có thể array với khoảng cách dòng và khoảng cach cột khác nhau vì mình không chơi với thằng measure nữa.

Còn nhanh hơn hay chậm hơn thì mình dành cho bạn tự rút ra kết luận.

Hề hề hề,

(defun c:mkin ()
(vl-load-com)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p (getpoint "\n Chon diem bat dau insert ")
         a (getreal "\n Nhap khoang cach theo hang: ")
         b (getreal "\n Nhap khoang cach theo cot: ")
         m (getint "\n Nhap so hang: ")
         n (getint "\n Nhap so cot: " )
)
(if (= b nil) (setq b a))
(if (= n nil) (setq n m))
(command "point" p )
(setq e1 (entlast))
(command "array" e1 ""  "r" m n a B)
(setq sspl (acet-ss-to-list (ssget "c" p (list (+ (car p) (* b (1- n))) (+ (cadr p) (* a (1- m)))) (list (cons 0 "point"))))
         plst (list) )
(foreach pt sspl
        (setq plst (append plst (list (cdr (assoc 10 (entget pt)))) ))
)

(setq pa (getstring t "\n Chon phuong an danh so < A, B, C>: "))
(cond 
     ((= (strcase pa) "A")
          (setq i 1)
          (command "pline" p (setq p1 (polar p (* 0.5 pi) (* a (1- m)))))
          (while (< i n)
                  (command p1 (setq p2 (polar p1 0 B)) )
                  (if (/= (rem i 2) 1)
                      (command (setq p3 (polar p2 (* 0.5 pi) (* a (1- m)))) )
                      (command (setq p3 (polar p2 (* 1.5 pi) (* a (1- m)))) )
                  )
                  (setq p1 p3 i (1+ i))
          )
          (command "")
      )
      ((= (strcase pa) "B")
            (command "pline")
            (while (and (> m 2) (> n 2))
                     (command p (setq p1 (polar p (* 0.5 pi) (* a (1- m)))) (setq p2 (polar p1 0 (* b (1- n)))) 
                                        (setq p3 (polar p2 (* 1.5 pi) (* a (1- m)))) (setq p4 (polar p3  pi (* b (- n 2)))) (setq p5 (polar p4 (* 0.5 pi)  a)) )
                     (setq m (- m 2) n (- n 2) p p5)
            )
            (if (> m 1) 
                (if (< n 2)
                (command p (polar p (* 0.5 pi) (* a (1- m))))
                (command p (setq p1 (polar p (* 0.5 pi) (* a (1- m)))) (setq p2 (polar p1 0 (* b (1- n)))) 
                                       (setq p3 (polar p2 (* 1.5 pi) (* a (1- m)))) (setq p4 (polar p3  pi (* b (- n 2)))) )
                )
            )
            (if (and (> n 1) (= m 1))
                (command p (polar p 0 (* b (1- n))))
            )
            (command "")
      )

      (T nil)
)

(setq e2 (entlast)
         plst (vl-sort plst  '(lambda (x y) (< (vlax-curve-getparamatpoint e2 (vlax-curve-getclosestpointto e2 x))
                                                                 (vlax-curve-getparamatpoint e2 (vlax-curve-getclosestpointto e2 y)) )))
         bl (cdr (assoc 2 (setq els (entget (car (entsel "\n Chon block thuoc tinh can rai"))))))
         ang (cdr (assoc 50 els))
         lay (cdr (assoc 8 els))
         col (if (assoc 62 els) (cdr (assoc 62 els)) 256)
         be (cdr (last (tblsearch "block" bl )))         
         list_att (list)
)
(while (setq be (entnext be))
      (if (= (cdr (assoc 0 (entget be))) "ATTDEF")
          (setq list_att (append list_att (list (cdr (assoc 1 (entget be))))))
      )
)
(setq j 1
         stt (getint "\n Nhap so thu tu cua thuoc tinh dung danh so: "))

(setq pb (list (+ (car p) (* b (+ 5 n))) (+ (cadr p) (* a m)))
        pb1 (polar pb 0 600)
        pb2 (polar pb1 (* 1.5 pi) (* (+ (length plst) 2) 50))
        pb3 (polar pb2 pi 600)
        pb4 (list (+ (car pb) 200) (- (cadr pb) 100))
        pb5 (list (+ (car pb) 200) (- (cadr pb) 50))
)
(command "line" pb pb1 pb2 pb3 "c")
(command "line" pb pb4 "")
(command "line" pb5 (polar pb5 0 400) "")
(command "line" (polar pb 0 200) (list (+ (car pb) 200) (- (cadr pb) (* (+ (length plst) 2) 50))) "")
(command "line" (polar pb 0 400) (list (+ (car pb) 400) (- (cadr pb) (* (+ (length plst) 2) 50))) "")
(styleset)
(command "text" "j" "mc" (list (+ (car pb) 150) (- (cadr pb) 25)) 16 0 "Toïa ñoä")
(command "text" "j" "mc" (list (+ (car pb) 50) (- (cadr pb) 75)) 16 0 "Soá thöù töï")
(command "text" "j" "mc" (list (+ (car pb) 300) (- (cadr pb) 25)) 16 0 "X")
(command "text" "j" "mc" (list (+ (car pb) 500) (- (cadr pb) 25)) 16 0 "Y")
(command "text" "j" "mc" (list (+ (car pb) 300) (- (cadr pb) 75)) 16 0 "(m)")
(command "text" "j" "mc" (list (+ (car pb) 500) (- (cadr pb) 75)) 16 0 "(m)")

(foreach pd plst
        (setq list_att (acet-list-remove-nth (1- stt) (ACET-LIST-INSERT-NTH (rtos j 2 0) list_att stt)))
        (makeinsert bl pd 1 ang list_att lay col nil)
        (setq x (rtos (car pd) 2 3) y (rtos (cadr pd) 2 3))
        (command "line" (list (car pb) (- (cadr pb) (* (1+ j) 50))) (list (+ (car pb) 600) (- (cadr pb) (* (1+ j) 50))) "")
        (command "text" "j" "mc" (list (+ (car pb) 100) (- (cadr pb) 25 (* (1+ j) 50))) 16 0 (rtos j 2 0))
        (command "text" "j" "mc" (list (+ (car pb) 300) (- (cadr pb) 25 (* (1+ j) 50))) 16 0 x)
        (command "text" "j" "mc" (list (+ (car pb) 500) (- (cadr pb) 25 (* (1+ j) 50))) 16 0 y)
        (setq j (1+ j))
)


(setvar "osmode" oldos)
(command "undo" "e")
)

(defun styleset (/ stl h)
(setq stl (getvar "textstyle")
        h (getvar "textsize"))
(if (/= h 0) (command "style" stl "" 0 "" "" "" "" ""))
)    

(defun dxf (dxfCode En) (cdr (assoc dxfCode (entget en))))      

;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun MakeInsert (Blkname inspoint scale ang list_att layer color xdata / lst obj i)
(setq lst '() i -1 en (cdr (last (tblsearch "block" Blkname))) obj (entget en))
(if (= (cdr(assoc 0 obj)) "ATTDEF")
(setq lst (list (list
	(cdr(assoc 10 obj))(cdr(assoc 11 obj))(cdr(assoc 50 obj))(cdr(assoc 8 obj))(cdr(assoc 70 obj))(cdr(assoc 62 obj))
	(cdr(assoc 40 obj))(assoc 7 obj)(assoc 71 obj)(assoc 72 obj)(assoc 2 obj)))))
(while (setq en (entnext en))
(if (= (cdr(assoc 0 (setq obj(entget en)))) "ATTDEF")
	(setq lst (cons (list
	(cdr(assoc 10 obj)) (cdr(assoc 11 obj))(cdr(assoc 50 obj)) (cdr(assoc 8 obj)) (cdr(assoc 70 obj)) (cdr(assoc 62 obj))
	(cdr(assoc 40 obj)) (assoc 7 obj) (assoc 71 obj) (assoc 72 obj) (assoc 2 obj)) lst) ) ) )
                (entmakex (list
	'(0 . "INSERT")'(100 . "AcDbEntity")
	(cons 8 (if Layer Layer (getvar "Clayer")))
	(cons 62 (if Color Color 256))
	'(100 . "AcDbBlockReference")
	(if list_att '(66 . 1) '(66 . 0))
	(cons 2 Blkname)
	(cons 10 (trans inspoint 1 0))
	(cons 41 scale)(cons 42 scale)(cons 43 scale)
	(cons 50 Ang)
	(cons -3 (if xdata (list xdata) nil))))
(if lst
(foreach LL (reverse lst)	
(entmake(list '(0 . "ATTRIB") '(100 . "AcDbEntity") (cons 8 (cadddr LL)) (cons 60 (nth 4 LL))
                       (if (nth 5 LL) (cons 62 (nth 5 LL)) '(62 . 256)) '(100 . "AcDbText")
      (cons 10 (mapcar '+ (trans inspoint 1 0) (mapcar '(lambda(x) (* scale x)) 
                                                                                                (polar '(0 0 0) (+(angle'(0 0 0)(car LL)) ang) (distance'(0 0 0)(car LL))))))
      (cons 40 (* scale (nth 6 LL)))
      (cons 1 (nth (setq i (1+ i)) list_att))
      (cons 50 (+ ang (caddr LL)))
      '(41 . 1.0) (nth 7 LL) (nth 8 LL) (nth 9 LL)
      (if (= 0 (cdr (nth 8 LL)) (cdr(nth 9 LL))) (cons 11(list 0 0 0))
	(cons 11 (mapcar '+ (trans inspoint 1 0) (mapcar'(lambda(x) (* scale x))
                                                                                                           (polar'(0 0 0) (+(angle '(0 0 0) (cadr LL)) ang) (distance '(0 0 0) (cadr LL)))))))
      '(100 . "AcDbAttribute")  ;;;'(280 . 0)
                       (last LL) '(70 . 0)  ;;;; '(280 . 1)
                       ))))
(dxf 330 (entmakex (list '(0 . "SEQEND") (cons 8 (if Layer Layer (getvar "Clayer")))))))
;;;;;;;;;;;;;;;;;  

Bạn chú ý rằng mình chưa khử biến, điều này không quá khó với bạn nên mong bạn tự giải quyết nhé.

[amateurday 16]

Thanks bác. Lisp vậy là vừa với ý em. :rolleyes:

[harrypotter2007 1]

Cám ơn bác phamthanhbinh và các bác trong diễn đàn đã giúp đỡ.Lisp mkin rất đúng ý e.Nhưng nó có 1 số điểm không được tốt lắm :

1. Lisp không rải được theo phương bất kì : file e gửi lên chỉ mang tính ví dụ. Thật ra e có 1 mặt bằng trên bình đồ, mặt bằng đó xiên 1 góc bất kì so với phương ngang và phương dọc.E cần rải nó theo phương bất kì và lấy tọa độ của cọc.

2.Không rải được bằng nhiều bước : ví dụ mặt bằng rải cọc của e có 40 cọc thuộc 2 khu vực với các bước rải a x b, c x d; khu vực 1 e rải bước 20 cọc với bước rải a x b, sang khu vực 2 e rải cọc 21-40 với bước rải c x d.E đánh số 21 cho bock cọc có att, nhưng nó không nhảy ra được 21-40.Không biết có phải cách tạo block att của e có vấn đề hay không?

3.Không có tính năng chọn vị trí để insert bảng tọa độ : e sử dụng lisp thì thấy nó insert tại điểm bất kì có thể chồng lên bản vẽ.

Chờ tin các bác.

http://www.cadviet.com/upfiles/3/103076_rai__danh_so_thu_tu_coc_1_1.dwg

[phamthanhbinh 3.146]

Cám ơn bác phamthanhbinh và các bác trong diễn đàn đã giúp đỡ.Lisp mkin rất đúng ý e.Nhưng nó có 1 số điểm không được tốt lắm :

1. Lisp không rải được theo phương bất kì : file e gửi lên chỉ mang tính ví dụ. Thật ra e có 1 mặt bằng trên bình đồ, mặt bằng đó xiên 1 góc bất kì so với phương ngang và phương dọc.E cần rải nó theo phương bất kì và lấy tọa độ của cọc.

2.Không rải được bằng nhiều bước : ví dụ mặt bằng rải cọc của e có 40 cọc thuộc 2 khu vực với các bước rải a x b, c x d; khu vực 1 e rải bước 20 cọc với bước rải a x b, sang khu vực 2 e rải cọc 21-40 với bước rải c x d.E đánh số 21 cho bock cọc có att, nhưng nó không nhảy ra được 21-40.Không biết có phải cách tạo block att của e có vấn đề hay không?

3.Không có tính năng chọn vị trí để insert bảng tọa độ : e sử dụng lisp thì thấy nó insert tại điểm bất kì có thể chồng lên bản vẽ.

Chờ tin các bác.

http://www.cadviet.c..._tu_coc_1_1.dwg

Hề hề hề,

1/- Lỗi tại bạn vì không nêu hết các trường hợp bạn cần. Người làm lisp chỉ căn cứ vào yêu cầu cụ thể của bạn chứ không phải có thể nghĩ hết mõi thứ bạn cần.

2/.- Nếu bạn đã dùng Cad nhiều và hiểu chút đỉnh về lisp thì hoàn toàn có thể ứng dụng lisp này cho tất cả các trường hợp mà bạn cần bằng cách kết hợp nó với hàm ucs.

3/- Việc chọn điểm đặt bảng thực tế là bạn cũng chả yêu cầu gì cả mà tự mình cho lisp chọn đấy thôi. nếu bạn muốn tự chọn hoàn toàn có thể làm được bằng cách thay thế việc chọn điểm pb trong lisp bằng đoạn code sau (setq pb (getpoint "\n chon diem dat bang")

4/- việc đánh số các block khi rải phụ thuộc vào cái biến j trong lisp. Ở đây mình đã cố tình bắt đầu đánh số từ 1 (setq j 1). Do đây là block thuộc tính nên cái số này hoàn toàn là bạn phải nhập vào chứ không phải chỉ thay thế nó trong block mẫu là được. Muốn vậy bạn có thể thay thế cái dòng (setq j 1) bằng dòng code sau (setq j (getint "\n Nhập giá tri bắt đầu danh so " ))

5/- Lisp này làm đã khá lâu, nay mới thấy bạn phản hồi. Nếu bạn thực sự cần và muốn chỉnh sửa chi đó thì hãy post cái bản vẽ cụ thể lên chứ nói suông thì rất khó hiểu.

6/- Ngay câu hỏi của mình khi bạn muốn đánh số theo vòng xoáy trôn ốc từ trong ra bạn cũng chưa trả lời. (đó chính là cái phương án C mà mình đang để chờ trong lisp chưa xài đến). vậy nếu bạn muốn hoàn chỉnh lisp thì hãy hoàn chỉnh cái tư duy của bạn để post vấn đề lên một cách đầy đủ và hoàn chỉnh các yêu cầu của bạn chứ đừng bắt người làm lisp phải tự nghĩ và giải quyết tất cả các vấn đề của chính bạn. Bằng không tất yếu bạn sẽ nhận được những thứ không đúng với cái bạn cần.....

 

Chúc bạn vui.

[harrypotter2007 1]

Cám ơn sự góp ý của bác phamthanhbinh.Do 1 số lý do mà mình phản hồi chậm như công việc bận không có thời gian theo dõi forum thường xuyên, cộng thêm mình nghĩ cần 1 khoảng thời gian thì các bác mới viết lisp được, chứ không phải muốn là có nên mình đã không theo dõi diễn đàn thường xuyên.Mình dùng cad đã lâu nhưng trước giờ chỉ dừng lại ở mức người sử dụng cad thuần túy, không biết gì về lisp.Nay nghe bác nói vậy em sẽ thử nghiên cứu viết cái lisp này xem sao.Nhưng chắc sẽ mất khá nhiều thời gian vì công việc em khá bận rộn và phải tìm hiểu lisp từ đầu ^^!Nếu trong quá trình tìm hiểu có gì không biết mong bác có thể nhiệt tình giúp đỡ.Chân thành cảm ơn sự giúp đỡ và góp y của bác!Chúc diễn đàn ngày càng phát triển!

[phung_gtvt 0]

Chào các anh em trong diễn đàn,

Nhân tiện chủ đề này mình nhờ anh em viết hộ mình lisp với nội dung như sau:

Mình đang có file excel (hoặc file text) tọa độ các cọc (xem file đính kèm), mình đã có lisp tự động vẽ ra được các cọc đó (tên lisp là importxyz - file đính kèm).

Vấn đề là cái lisp này chỉ vẽ ra được các cọc theo file tọa độ đã cho nhưng không điền được tên cọc.

Anh em giúp mình xử lý vụ này với.

Cám ơn nhiều !http://www.cadviet.c...g__20120704.dwg

http://www.cadviet.c...mportxyzatt.rar

http://www.cadviet.c..._coordinate.rar

[phung_gtvt 0]

Anh em nào biết mong giải quyết vấn đề trên cho mình với.

Mình đã tìm và hỏi nhiều người nhưng chưa có câu trả lời thỏa đáng.

Ở công ty mình có anh Hàn Quốc có lisp hay lắm nhưng có điều toàn tiếng Hàn nên ko làm ăn gì dc hii.

[VoHoan 6]

File Excell bạn đưa lên bị lỗi hay sao mà không mở được. Mà nhìn vào cái lisp importxy dđế sửa lại được thì phải nhờ cao thủ CV hoặc tác giả của nó mới sửa lại giúp bạn được thôi.

[phamthanhbinh 3.146]

Anh em nào biết mong giải quyết vấn đề trên cho mình với.

Mình đã tìm và hỏi nhiều người nhưng chưa có câu trả lời thỏa đáng.

Ở công ty mình có anh Hàn Quốc có lisp hay lắm nhưng có điều toàn tiếng Hàn nên ko làm ăn gì dc hii.

Hề hề hề,

Bạn có thể post một khúc lisp Hàn quốc ấy lên không???

Đã là lisp thì theo mình nghĩ nó có cùng cú pháp chung chứ chả nhẽ lisp Hàn quốc khác với lisp Việt nam sao???

Có nhẽ mấy anh cu Hàn Quốc này có một ngôn ngữ lập trình khác chứ không phải lisp. Cái ngôn ngữ này nó có thể có cấu trúc gần với lisp nhưng sử dụng giao tiếp bằng tiếng Hàn chứ không phải lisp đâu.

Hề hề hề,...

[Tue_NV 3.912]

Chào các anh em trong diễn đàn,

Nhân tiện chủ đề này mình nhờ anh em viết hộ mình lisp với nội dung như sau:

Mình đang có file excel (hoặc file text) tọa độ các cọc (xem file đính kèm), mình đã có lisp tự động vẽ ra được các cọc đó (tên lisp là importxyz - file đính kèm).

Vấn đề là cái lisp này chỉ vẽ ra được các cọc theo file tọa độ đã cho nhưng không điền được tên cọc.

Anh em giúp mình xử lý vụ này với.

Cám ơn nhiều !http://www.cadviet.c...g__20120704.dwg

http://www.cadviet.c...mportxyzatt.rar

http://www.cadviet.c..._coordinate.rar

Cái này viết thêm cho bạn nè

(defun c:dscoc(/ ss i Tue-dxf Tue-ss-list)
(defun Tue-dxf (dxf ename)(cdr(assoc dxf (entget ename))))
(defun Tue-ss-list (L-ss-vlaobj / n L Lst ssg vlaobj)
 (mapcar 'set '(ssg vlaobj) L-ss-vlaobj)
 (setq L (sslength ssg))
 (Repeat L
   	(setq ename (ssname ssg (setq L (1- L))))
   (setq Lst (cons (if vlaobj (vlax-ename->vla-object ename) ename) Lst))
 )
)
 (setq i 0)
 (princ "\n Chon cac coc nho can danh so : ")
 (if (setq ss (ssget '((0 . "CIRCLE") (40 . 0.25))))
     (foreach x (reverse (Tue-ss-list  (list ss)))
  	(entmake (list (cons 0 "TEXT") (cons 1 (itoa (setq i (1+ i)))) (cons 40 0.30)
  		   (cons 10 (mapcar '+ (Tue-dxf 10 x) '(0.0 0.5 0.0)))
  		   (cons 11 (mapcar '+ (Tue-dxf 10 x) '(0.0 0.5 0.0)))
  	))
   )
 )
)

-> Lisp lọc chọn các cọc nhỏ và đánh số thứ tự như file kèm theo