Viết lisp theo yêu cầu [phần 2]

[phamthanhbinh 3149]

Rất cảm ơn bạn ketxu. Lisp của bạn viết rất hay, mình rất vui. Nhưng bạn viết theo ý tưởng của mình thì tốt quá. ví dụ như bạn chọn vùng cần vẽ rồi nhập từng số thứ tự vẽ có được không: kiểu như

nhập số thứ tự bắt đầu? 1

số thứ tự tiếp theo? 2

số thứ tự tiếp theo? 5

số thứ tự tiếp theo? xxx

tương ứng mỗi lần nhập như thế thi vẽ line theo số thứ tự nhập vào vậy đó.

vì đây là file vẽ bản đồ, muốn vẽ 1 địa vật như nhà, đưòng GT hay một địa vật nào đó. số thứ tự cần nối không phải là cứ 1 rồi 2 rồi ...n. vì khi đo có thể quên hoặc đo diểm khác trước rồi mới quay lại cho nên stt cần nối không phải là từ 1 đến 2 rồi đến 3 rồi n được. cảm ơn bạn nhiều.

Hề hề hề,

Yêu cầu của bạn hoàn toàn có thể làm được dựa trên cái lisp bác ketxu đã viết, chỉ cần bạn thay đổi việc chọn các đối tượng theo vùng bằng cách pick chọn các đối tượng theo trình tự bạn cần mà thôi.

Bạn hãy thử xem nhé

[shitty 3]

thanks bác !!!cuối cùng thì e cũng dùng được rồi...

có 1 lisp ve hatch cũng tham khảo trên diễn đàn nhưng e gà về lisp wá mong bác sửa giup với...đoạn lisp này sau khi hatch xong thi nó không tự chuyển về layer 00-09hatch và không có chế độ associative..e cũng mò thử thêm dòng (setvar "hpassoc" 1) vaf (setvar "hpgaptol" 1000.0) để có thể hatch cả miền hở nhưng bó tay :)...nên phai nhờ cao thủ giúp thôi.

;===== AUTO HATCH (hh) ========

(defun mkhatch(v_hatchtp v_scale v_angle data_m / i)
(command "hatch" v_hatchtp v_scale v_angle)
(setvar "hpassoc" 1)
       (setq i 0)
(while (< i (length data_m)) (progn
	(command (nth i data_m))
	(setq i (+ i 1))
))
(command "")  
)

(defun c:hh(/ data_m check)


(defun ah_import(/ p1 p2 old1 ent1 ent2 axa)
 (if (= nil hscale_d) (setq hscale_d 1))  
 (setq old1 (getvar "osmode") check 1)
 (setvar "osmode" 0)
 (setq p1 '(0 0 0) p2 p1)
 (command "line"  p1 p2 "")

 (setq data_m '())
 (setq ent1 (entlast) ent2 ent1)

 (princ ent1)

 (setvar "osmode" old1)

 (command "boundary")
 (setq p1 (getpoint))
 (while (not (= nil p1)) (progn

(command p1)


(setq p1 (getpoint))

 ))
 (command "")

 (setq ent1 (entnext ent1))

 (princ ent1)
 (if (= nil ent1) (setq check 0) (progn
(while (not (= nil ent1)) (progn
	(setq data_m (append data_m (list ent1)))
	(setq ent1 (entnext ent1))
))
 ))
 (command "erase" ent2 "")
 (princ)
)

(defun ah_procced(/ i s1)

 (if (= 0 check) (princ "\ninvalid data") (progn
(initget 1 "0 WALL W GRASS GR GROUND G MARBLE M WC S SAND B BRICK")
 	(setq s1 (getkword "\n0/Wall/Grass/Ground/MARBLE/WC/Sand/BRICK : "))
(if (not (= nil s1)) (progn
	(cond
	  ((= "0" (strcase s1)) (mkhatch "dots" (* 1500 hscale_d) 0 data_m))
	  ((= "WC" (strcase s1)) (mkhatch "ansi37" (* 2000 hscale_d) 45 data_m))
	  ((or (= "GR" (strcase s1)) (= "GRASS" (strcase s1))) (progn
			(mkhatch "CROSS" (* 500 hscale_d) 0 data_m)

	  ))
	  ((or (= "S" (strcase s1)) (= "SAND" (strcase s1))) (progn
			(mkhatch "ar-sand" (* 30 hscale_d) 0 data_m)


	  ))

((or (= "G" (strcase s1)) (= "GROUND" (strcase s1))) (mkhatch "hound" (* 3000 hscale_d) 0 data_m))
((or (= "M" (strcase s1)) (= "MARBLE" (strcase s1))) (mkhatch "ar-conc" (* 30 hscale_d) 0 data_m))
((or (= "B" (strcase s1)) (= "BRICK" (strcase s1))) (mkhatch "ar-b816c" (* 25 hscale_d) 0 data_m))
((or (= "W" (strcase s1)) (= "WALL" (strcase s1))) (mkhatch "ANSI31" (* 300 hscale_d) 0 data_m))
	)
   ))						 

(command "erase")
(setq i 0)
(while (< i (length data_m)) (progn
	(command (nth i data_m))
	(setq i (+ i 1))
))
(command "")

 ))

 (princ)
)
 (ai_undo_push)	
 (ah_import)

 (ah_procced)
 (ai_undo_pop)
)

 

hix hok có bác nào xem giúp e với ah...cuối năm nên chắc các bác cũng bận :)....năm hết tết đến,chúc cho diễn đàn ngày càng phát triển,ban quản trị và các thành viên 1 năm mới nhiều sức khỏe và nhiều ...xiền...heh.

[phonui059 0]

Hề hề hề,

Yêu cầu của bạn hoàn toàn có thể làm được dựa trên cái lisp bác ketxu đã viết, chỉ cần bạn thay đổi việc chọn các đối tượng theo vùng bằng cách pick chọn các đối tượng theo trình tự bạn cần mà thôi.

Bạn hãy thử xem nhé

Có thể mình yêu cầu hơi cao. ở đây mình muốn khi chọn vùng cần vẽ rồi mình nhập số thứ tự thì Cad tự tìm đến mà nối line vậy đó

( kiểu như lệnh find rồi zoomto ấy) Lisp của bác ketxu cũng rất hay. nếu như cần vẽ chỗ nào thì chọn vào vùng ấy thì nối sẽ đúng, nếu chọn nhiều hơn thì nó tự tìm các điểm nối theo thứ tự tăng dần thôi.

[ketxu 3005]

hix hok có bác nào xem giúp e với ah...cuối năm nên chắc các bác cũng bận :)....năm hết tết đến,chúc cho diễn đàn ngày càng phát triển,ban quản trị và các thành viên 1 năm mới nhiều sức khỏe và nhiều ...xiền...heh.

F

File lisp của bạn mình k hiểu hết được, vì nó rườm rà quá, có lẽ bạn nếu ý tưởng để mọi người viết cái mới thì tốt hơn sửa code ^^

 

Có thể mình yêu cầu hơi cao. ở đây mình muốn khi chọn vùng cần vẽ rồi mình nhập số thứ tự thì Cad tự tìm đến mà nối line vậy đó

( kiểu như lệnh find rồi zoomto ấy) Lisp của bác ketxu cũng rất hay. nếu như cần vẽ chỗ nào thì chọn vào vùng ấy thì nối sẽ đúng, nếu chọn nhiều hơn thì nó tự tìm các điểm nối theo thứ tự tăng dần thôi.

Với yêu cầu nhập số đến đâu thì kéo chuột line đến đấy thì phải xử lý hàm pause, mình không rành về cái này lắm nên chắc phải từ từ nghiên cứu ^^

[ketxu 3005]

Rất cảm ơn bạn ketxu. Lisp của bạn viết rất hay, mình rất vui. Nhưng bạn viết theo ý tưởng của mình thì tốt quá. ví dụ như bạn chọn vùng cần vẽ rồi nhập từng số thứ tự vẽ có được không: kiểu như

nhập số thứ tự bắt đầu? 1

số thứ tự tiếp theo? 2

số thứ tự tiếp theo? 5

số thứ tự tiếp theo? xxx

tương ứng mỗi lần nhập như thế thi vẽ line theo số thứ tự nhập vào vậy đó.

vì đây là file vẽ bản đồ, muốn vẽ 1 địa vật như nhà, đưòng GT hay một địa vật nào đó. số thứ tự cần nối không phải là cứ 1 rồi 2 rồi ...n. vì khi đo có thể quên hoặc đo diểm khác trước rồi mới quay lại cho nên stt cần nối không phải là từ 1 đến 2 rồi đến 3 rồi n được. cảm ơn bạn nhiều.

Sau khi tìm hiểu hàm pause, mình đã làm lại cho bạn đây.Nói chung lisp này khá khù khoằm và không được đẹp, lại chẳng liên quan gì tới lisp đầu tiên mình viết cho bạn, tức là phải mần lại từ đầu ý, nên có hơi lâu.Bạn thử dùng xem sao.Hy vọng đã đúng ý bạn. Lệnh vẫn như cũ

 

;;free lisp from cadviet.com @ ketxu
(defun c:pt2p(/ ss ssename listso spt sodautien sotieptheo )
(vl-load-com)
;Loc text, khoi tao bien
(setq ss (ssget '((0 . "TEXT") (8 . "CT_SO")))
      ssename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      listso '()
) 
;list so
(foreach x ssename 
	(setq  listso (append (list (atoi (cdr(assoc 1 (entget x))))) listso))
)
(setq listso (reverse listso))
;Kiem tra dau vao va ve	
(setq sodautien (getint "\nSo  dau tien:")
	spt (check sodautien listso)
) 
(while (=  spt nil) (setq sodautien (getint "\nSo ban chon khong co trong tap chon.Xin chon lai:"))
(setq spt (check sodautien listso))) 
(command ".line" (cdr(assoc 10 (entget (nth spt ssename)))))
(while (= 4 (getvar "CMDACTIVE")) (command pause))

(while (/= (setq sotieptheo (getint "\nNhap so tiep theo :")) nil)(setq spt (check sotieptheo listso))
(while  (= spt nil) (setq sotieptheo (getint "\nSo ban chon khong co trong tap chon.Xin chon lai:"))
(setq spt (check sotieptheo listso)))
(command (cdr(assoc 10 (entget (nth spt ssename)))))
(while (= 4 (getvar "CMDACTIVE")) (command pause)))
)
;Kiem tra va lay so thu tu cua phan tu e trong list, neu khong tra ve nil
(defun check (e lst /)
(setq i 0)
(while (and (/= (setq e_i (nth i lst)) e) ((setq i (1+ i))
)
(if (= e_i nil) (setq i nil))
i)

 

 

@Các bác viết lisp : Hiện nay với các code có dùng hàm vl, e thường áp dụng đoạn này

ssename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

để lấy list ename của tập chọn ss thay vì hàm ss2ent của bác Hoành vì thấy gọn hơn , nhưng quả thực e chưa suy luận được cái nào tốt hơn cái nào, mong các bác phân tích và chỉ giáo

[phamthanhbinh 3149]

@Các bác viết lisp : Hiện nay với các code có dùng hàm vl, e thường áp dụng đoạn này

ssename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

để lấy list ename của tập chọn ss thay vì hàm ss2ent của bác Hoành vì thấy gọn hơn , nhưng quả thực e chưa suy luận được cái nào tốt hơn cái nào, mong các bác phân tích và chỉ giáo

 

Chào bác ketxu,

Quả thực câu hỏi của bác mình không trả lời được, song nó lại đẻ ra cái câu hỏi mà mình mong bác sẽ giải đáp giùm.

1/- Đó là mình nhòm ngó tìm kiếm trong help thì cái hàm ssnamex này có cú pháp là (ssnamex ss index). Và nếu thành công nó sẽ trả về một list có chứa các phần tử là các associate list tùy thuộc vào cách chọn tập hợp các đối tượng.

Vậy nhưng ở đây bác lại dùng (ssnamex ss) mà chả có cái index kèm theo. Vậy nó sẽ trả về cái chi bác hè????

 

2/- Nều chỉ là lấy danh sách các ename của các đối tượng có trong tập chọn ss, vì sao bác lại không dùng hàm (acet-ss-to-list ss) vì cứ theo cái ngu ý của mình thì nó có vẻ dễ dùng hơn bác ạ????

 

Vài cái thắc mắc, có thể không được minh mẫn cho lắm, mong bác chớ giận và cố gắng giải đáp giùm để mình bớt ....... thắc mắc hỉ????

Chúc bác khỏe và vui.....

[gia_bach 1558]

Sau khi tìm hiểu hàm pause, mình đã làm lại cho bạn đây.Nói chung lisp này khá khù khoằm và không được đẹp, lại chẳng liên quan gì tới lisp đầu tiên mình viết cho bạn, tức là phải mần lại từ đầu ý, nên có hơi lâu.Bạn thử dùng xem sao.Hy vọng đã đúng ý bạn. Lệnh vẫn như cũ

 

...............................

@Các bác viết lisp : Hiện nay với các code có dùng hàm vl, e thường áp dụng đoạn này

ssename (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))

để lấy list ename của tập chọn ss thay vì hàm ss2ent của bác Hoành vì thấy gọn hơn , nhưng quả thực e chưa suy luận được cái nào tốt hơn cái nào, mong các bác phân tích và chỉ giáo

Chào bác ketxu.

Về mặt lí thuyết thì hàm ss2ent của bác Hoành chạy nhanh hơn cách sử dụng hàm (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))).

 

Tuy nhiên thực tế hàm (ssnamex ss) trả về những giá trị gì ?

ssnamex : Retrieves information about how a selection set was created.

Vì hàm (ssnamex ss) trả về nhiều thông tin, nghĩa là CAD phải sử lí nhiều thao tác không cần thiết ?!

 

Chúng ta cùng xem xét 1 tập chọn ss gồm 10 đối tượng.

Ở hình trên, ngoài thông tin về 10 đối tượng CAD còn trả về 4 dòng thông tin về các tọa độ khi người dùng pick trên màn hình.

Trong t/hợp truy xuất các đối tượng các thông tin này không cần thiết (nhưng ở t/hợp khác thì nó lại có ý nghĩa).

Tuy nhiên với tốc độ của máy tính hiện nay, thì thời gian này không đáng kể so với thời gian người dùng pick chọn đối tượng trên màn hình.

Sự khác biệt về tốc độ chỉ có ý nghĩa với các t/hợp phương pháp chọn đối tượng phức tạp (WPolygon, CPolygon, Fence, ... )

Vài dòng chia sẻ cùng bạn.

 

 

Chào bác ketxu,

Quả thực câu hỏi của bác mình không trả lời được, song nó lại đẻ ra cái câu hỏi mà mình mong bác sẽ giải đáp giùm.

1/- Đó là mình nhòm ngó tìm kiếm trong help thì cái hàm ssnamex này có cú pháp là (ssnamex ss index). Và nếu thành công nó sẽ trả về một list có chứa các phần tử là các associate list tùy thuộc vào cách chọn tập hợp các đối tượng.

Vậy nhưng ở đây bác lại dùng (ssnamex ss) mà chả có cái index kèm theo. Vậy nó sẽ trả về cái chi bác hè????

 

2/- Nều chỉ là lấy danh sách các ename của các đối tượng có trong tập chọn ss, vì sao bác lại không dùng hàm (acet-ss-to-list ss) vì cứ theo cái ngu ý của mình thì nó có vẻ dễ dùng hơn bác ạ????

 

Vài cái thắc mắc, có thể không được minh mẫn cho lắm, mong bác chớ giận và cố gắng giải đáp giùm để mình bớt ....... thắc mắc hỉ????

Chúc bác khỏe và vui.....

chào bác Bình.

câu 1 : bác xem hình tôi đã viết ở trên.

câu 2 : dĩ nhiên là hàm (acet-ss-to-list ss) đúng là cái chúng ta cần. Nhưng ý của ketxu là quan tâm đến cái nào tốt hơn ?

[ketxu 3005]

@ Bác Phamthanhbinh :

1.E cũng hiểu nôm na là ntn :

Cú pháp của nó là (ssnamex ss [index]) :tức chỉ số index là option có hoặc không.Nếu đặt số cho nó thì kết quả sẽ trả về đúng thằng thứ [index] trong tập ss, bao gồm lssindex, ename và cách chọn ename (data dạng list).Nếu ta bỏ qua thông số này, kết quả sẽ trả về toàn bộ các phần tử , tức là sẽ thu được 1 list bao gồm các sublist của các phần tử và sắp xếp lại theo kiểu ((id ename1 data) (id ename2 data).....(list data))

Trong help viết là :

((sel_id1 ename1 (data))(sel_id2ename2 (data)) ... )

Sau đó ta lấy (mapcar 'cadr (ssnamex ss)) : lấy được list các phần tử bao gồm (ename+ phần tử thứ 2 của list data) -> Xóa cái phần tử thứ 2 của list data ở type list đi thì ta còn lại list ename

2.E đã thấy các bác trên 4room dùng nhiều hàm acet, nhưng chưa thực hành bao giờ ( vì bác Đường Thái khuyên e cẩn thận đừng lợi dụng kẻo nó chậm hơn ^^), có lẽ sau đây e xin đi vào thực tế để xem nó ntn ^^

 

P/S : e post lên thì đã thấy bác gia_bach giải thích cặn kẽ rồi ^^

[phonui059 0]

Sau khi tìm hiểu hàm pause, mình đã làm lại cho bạn đây.Nói chung lisp này khá khù khoằm và không được đẹp, lại chẳng liên quan gì tới lisp đầu tiên mình viết cho bạn, tức là phải mần lại từ đầu ý, nên có hơi lâu.Bạn thử dùng xem sao.Hy vọng đã đúng ý bạn. Lệnh vẫn như cũ

cảm ơn bạn ketxu rất nhiều. đây thực sự là cái mình đang cần. cảm ơn bạn nhiều lắm.

[hungvq 0]

Mấy hôm rùi mình không theo dõi thường xuyên nên hôm nay mới trả lời bạn Ketxu được.

Cái lip "dt2" của bạn mình sử dụng ok rùi. Cảm ơn bạn Ketxu nhá!

[shitty 3]

hix hok có bác nào xem giúp e với ah...cuối năm nên chắc các bác cũng bận :)....năm hết tết đến,chúc cho diễn đàn ngày càng phát triển,ban quản trị và các thành viên 1 năm mới nhiều sức khỏe và nhiều ...xiền...heh.

hok có bác nào giúp e sửa cái lisp này với nhỉ..:) huh

[ketxu 3005]

hok có bác nào giúp e sửa cái lisp này với nhỉ..:) huh

Mình đã reply rồi mà bạn không để ý đó chứ : thà bạn nêu ý tưởng, mọi người viết cái mới giúp bạn có khi còn dễ hơn là sửa lại từ 1 code của tác giả khác ^^

[phonui059 0]

Nhờ các bạn sửa lại dùm tôi lisp này với. tôi cũng down trên cadviet về dùng. nhưng khi đánh lệnh thì nó chạy lặp lại 2 vòng trong khi đó chỉ cần 1 vòng là đủ, các bạn xem bản vẽ sẽ hiểu, nhờ các bạn sửa lại dùm. cảm ơn nhieeuf.

http://www.cadviet.com/upfiles/3/hskt.lsp

http://www.cadviet.com/upfiles/3/drawing1_51.dwg

[ketxu 3005]

Bạn à, cái này mục đích để ghi liên tiếp các vùng, không chỉ 2,mà nhiều nhiều ^^, với tiêu chí của tác giả là giải bài toán trong trường hợp tổng quát ^^ Nếu bạn muốn làm ngược lại thì cũng được thôi,nhưng liệu có nên :) Khi thực hiện lệnh xong, nếu bạn không muốn nữa thì đến chỗ nó hỏi điểm đầu, bạn cứ "Cách" 1 phát là xong mà, nhẹ nhàng ^^

 

Còn nếu quyết tâm dùng 1 lần, thì bạn dùng tạm cái này, mình bỏ hàm lặp while đi thôi, nó sẽ chỉ chạy 1 lần là out ^^."Tạm" là vì nó còn thông báo Unknown.... do có hàm Command nào đó bị ảnh hưởng, nhưng mình nghĩ k quan trọng :)

 

p/s : bạn có thể cho mình biết cái lisp này bác nào viết k ? Để mình ghi vào @ ^^

;; free lisp from cadviet.com

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;Chuong trinh danh so va lap bang toa do ho so thua dat dia chinh
;;;Bang toa do tao thanh block, duoc dat ten theo so thu tu 1, 2, 3...
;;;Chap nhan cac doi tuong la Region, Polyline, Line va Arc khep kin
;;;Written by - January 2009 - www.cadviet.com
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;PUBLIC FUNCTIONS
;;;-------------------------------------------------------------------------------
(Defun DTR (x) (/ (* x pi) 180))
;;;change degree to radian, return REAL
;;;-------------------------------------------------------------------------------
(defun lineP (p0 a r / p1)
;;;Line polar: point, degree angle, radius
 (setq p1 (polar p0 (dtr a) r))
 (command "line" p0 p1 "")
)
;;;-------------------------------------------------------------------------------
(defun linePX (p0 x) (lineP p0 0 x))
;;;Horizontal line: length x, from p0
;;;-------------------------------------------------------------------------------
(defun linePY (p0 y) (lineP p0 90 y))
;;;Vertical line: length y, from p0
;;;-------------------------------------------------------------------------------
(defun getVert (e / i L)
;;;Return list of all vertex from pline e
 (setq	i 0
L nil
 )
 (vl-load-com)
 (repeat (fix (+ (vlax-curve-getEndParam e) 1))
   (setq L (append L (list (vlax-curve-getPointAtParam e i))))
   (setq i (1+ i))
 )
 L
)

;;; First point of List rearrangement
(defun relist(pt0 Lst / i rt)
 (setq i 0)
 (foreach pt Lst
   (if (equal pt0 pt 0.001)
     (setq rt i))
   (setq i (1+ i)))
 (append (append (member (nth rt Lst) Lst)
     (cdr (reverse (cdr (member (nth rt Lst) (reverse Lst))))))
  (list (nth rt Lst)))
)

;;;New Layer
(defun newlayer(a b c d) 
   (if (not (tblsearch "layer" a))
      (command "-layer" "n" a "c" b a "l" c a "lw" d a ""))
)
;;;-------------------------------------------------------------------------------
(defun wtxtMC (txt p h k)
;;;Write text Middle Center, specify text, point, height
 (entmake (list (cons 0 "TEXT")
	 (cons 7 (getvar "textstyle"))
	 (cons 1 txt)
	 (cons 10 p)
	 (cons 11 p)
	 (cons 40 h)
	 (cons 72 1)
	 (cons 73 2)
	 (if k (cons 51 (DTR 18)) (cons 51 0))
   )
 )
)
;;;-------------------------------------------------------------------------------
(defun Collect (e / e2 SS)
;;;Selection set from e to entlast
 (setq SS (ssadd))
 (ssadd e SS)
 (while (setq e2 (entnext e)) (ssadd e2 SS) (setq e e2))
 SS
)
;;;-------------------------------------------------------------------------------
(defun Collect1	(e / ss)
;;;Selection set after e to entlast. If e nil, select all from fist entity of drawing.
 (if (= e nil)
   (setq ss (collect (entnext)))
   (progn (setq ss (collect e)) (ssdel e ss))
 )
)
;;;-------------------------------------------------------------------------------

;;;PRIVATE FUNCTIONS
;;;-------------------------------------------------------------------------------
(defun txt1 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
 (setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 7 h))
   p3 (polar p2 0 (* 10 h))
   p4 (polar p3 0 (* 9 h))
   pL (list p1 p2 p3 p4)
   i  0
 )
 (repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h t)
   (setq i (1+ i))
 )
)
;;;-------------------------------------------------------------------------------
(defun txt2 (txtL / p1 p2 p3 p4 pL i)
;;;Write texts in 1 row
 (setq
   p1 (list (+ (car p0) (* 2 h)) (- (cadr p0) (* 1.5 h)))
   p2 (polar p1 0 (* 7 h))
   p3 (polar p2 0 (* 10 h))
   p4 (polar p3 0 (* 9 h))
   p4 (polar p4 (* 0.5 pi) h)
   pL (list p1 p2 p3 p4)
   i  0
 )
 (repeat 4
   (wtxtMC (nth i txtL) (nth i pL) h t)
   (setq i (1+ i))
 )
)
;;;-------------------------------------------------------------------------------
;;;MAIN PROGRAM
;;;-------------------------------------------------------------------------------
(defun C:HSKT (/ h p et p0 p00 p01 p02 pt pvL n j pv num txtL ss bn ntp)
 (setvar "cmdecho" 0)

;;;New layer check
 (newlayer "kichthuoc" 7 "continuous" "default")
 (newlayer "stt" 1 "continuous" "default")
 (newlayer "bangtd" 7 "continuous" "default")

;;;GET TEXT HEIGHT
 (if (not h0)  (setq h0 1))
 (setq h (getreal (strcat "\nChon chieu cao text :")))
 (if (not h)  (setq h h0)  (setq h0 h))

;;;GET DECIMAL PRECISION
 (if (not ntp0)  (setq ntp0 2))
 (setq ntp (getint (strcat "\nSo chu so thap phan :")))
 (if (not ntp)  (setq ntp ntp0)  (setq ntp0 ntp))

;;;GET CIRCLE RADIUS
 (if (not cr0)  (setq cr0 0.3))
 (setq cr (getreal (strcat "\nNhap ban kinh vong tron :")))
 (if cr (setq cr0 cr))

;;;PICK & BASE POINT
 (initget "Y")
 (setq save (getkword "\nBan co muon luu file? :"))

 (setq oldos (getvar "osmode")
pdau (getpoint "\nPick diem dau tien (so thu tu = 1): " )
 )  

 ;(while pdau
   (setq p (getpoint "\nPick 1 diem giua mien kin:")
  pvL nil pvL1 nil)
   (command "boundary" p "")
   (setq et (entlast)
         pvL1 (reverse (getvert et)))  
   (redraw et 3)  
   (setq p00 (getpoint "\nDiem dat Bang TDGR:"))
   (command "erase" et "")
   (setq  p0 p00
          p01  (polar p00 (* 1.5 pi) (* h 3))    
          pvL  (relist pdau pvL1)
          n	(length pvL)
          p02	(polar p01 (* 1.5 pi) (+ (* h 3) (* (1- n) h 2)))
   )  
   (setvar "osmode" 0)
;;;HEADER
 (setvar "CLAYER" "bangtd")
 (linepx p0 (* 32 h))
 (command "copy" "L" "" "m" p00 p01 p02 "")
 (linepy p0 (- (distance p0 p02)))
 (command "copy" "L" "" "m"  p0
   (list (+ (car p0) (* 4 h)) (cadr p0))
   (list (+ (car p0) (* 14 h)) (cadr p0))
   (list (+ (car p0) (* 24 h)) (cadr p0))
   (list (+ (car p0) (* 32 h)) (cadr p0))
   "")
 (setq Lkqua nil)
 (wtxtMC "BAÛNG TOÏA ÑOÄ GOÙC RANH"
  (polar (polar p0 0 (* 16 h)) (* 0.5 pi) (* 2 h))
	 (* 1.2 h) nil)
 (txt1 (setq Lkq (list "TT" "X (m)" "Y (m)" "S (m)")))
 (setq Lkqua (append Lkqua (list Lkq)))
 (setq p0 (polar p0 (* 1.5 pi) (* 3 h)))

;;;MAKE RECORDS
 (setq	j  0
pt nil)
 (repeat n
   (setq
     pv  (nth j pvL)
     num (itoa (1+ j))
   )
   (if	pt
     (setq S (rtos (distance pt pv) 2 ntp))
     (setq S "")
   )
   (setq
     txtL (list num (rtos (car pv) 2 ntp) (rtos (cadr pv) 2 ntp) S)
     Lkqua (append Lkqua (list txtL))
   )
   (txt2 txtL)
   (setq p0 (polar p0 (* 1.5 pi) (* 2 h)))
   (setq pt pv)
   (setq j (1+ j))
   (if	(= j (- n 1))  (setq j 0))
 )

;;;MAKE BLOCK
 (setq ss (collect1 et))
 (setq bn "1")
 (while (tblsearch "block" bn)
   (setq bn (itoa (1+ (atoi bn))))
 )
 (command "block" bn p00 ss "")
 (command "insert" bn p00 "" "" "")

;;;WRITE POINT NAME
 (setvar "CLAYER" "stt")
 (setq j 0)
 (repeat (1- n)
   (setq
     pv  (nth j pvL)
     num (itoa (1+ j))
   )
   (wtxtMC num (polar pv 0 h) h t)
   (command "circle" pv cr0)
   (command "erase" vtron "")
   (setq j (1+ j))
 )

;;;GHI CANH THUA
   (setvar "CLAYER" "kichthuoc")
   (ghicanh)  

;;;FINISH
   (savef)
   (setvar "osmode" oldos)
   ;(setq pdau (getpoint "\nPick diem dau tien (so thu tu = 1) :"))
 ;;; )  
 (setvar "cmdecho" 1)
 (princ)
)

;;;-------------------------------------------------------------------------------
(defun savef()  
 (if save
   (progn
     (setq file (open (setq tenfile (strcat (getvar "dwgprefix")
 (vl-filename-base (vl-string-right-trim "\\" (getvar "dwgname"))) ".txt")) "a"))
     (foreach line Lkqua
(setq line1 "")
(foreach it line
  (setq line1 (strcat line1 " " it)))
(write-line line1 file)
     )
     (close file)
     (princ (strcat "\nDa luu thanh file " tenfile))
   )
 )
)

;;;PHAN BO SUNG 
;;;------------------------------------------------------------------------------------
(defun Text_canh_TCA (S p a )
;;;Entmake text S at p with angle A - Top Center
 (if (/= p nil)
   (entmake (list
       (cons 0 "TEXT")
       (cons 62 2)
       (cons 10 p)
       (cons 40 h)
       (cons 1 S)
       (cons 50 a )
       (cons 41 0.7)
       (cons 7 (getvar "textstyle"))
       (cons 72 1)
       (cons 11 p)
       (cons 73 3)
     )
   )
 )
)
;;;------------------------------------------------------------------------------------
(defun Text_canh_BCA (S p a )
;;;Entmake text S at p with angle A - Bottom Center
 (if (/= p nil)
   (entmake (list
       (cons 0 "TEXT")
       (cons 62 2)
       (cons 10 p)
       (cons 40 h)
       (cons 1 S)
       (cons 50 a )
       (cons 41 0.7)
       (cons 7 (getvar "textstyle"))
       (cons 72 1)
       (cons 11 p)
       (cons 73 1)
     )
   )
 )
)
;;;-------------------------------------------------------------------------------
(defun Ghicanh (/ i k p1 p2 dist rad x_mp y_mp mp)
 (setq
   i	0   
   k	(1- (length pvL))
 )
 (repeat k
   (setq
     p1   (nth i pvL)
     p2   (nth (+ i 1) pvL)
     dist (distance p1 p2)
     rad  (angle p1 p2)
     x_mp (* (+ (car p1) (car p2)) 0.5)
     y_mp (* (+ (cadr p1) (cadr p2)) 0.5)
     mp   (list x_mp y_mp)
   )
   (if	(and (> rad (* 0.5 pi)) (      (setq mp (polar mp (+ rad (* 0.5 pi)) (* 0.3 h)))
   )
   (if	(and (> rad (* 0.5 pi)) (      (progn
(setq rad (+ rad pi))
(Text_canh_TCA (rtos dist 2 2) mp rad)
     )
     (Text_canh_BCA (rtos dist 2 2) mp rad)
   )
   (setq i (1+ i))
 )
 ;; repeat k;
)
;;;--------------------------

[tuvanthietke.hcm 4]

Lisp vẽ móng BTCT ^^ Bạn nào có không, mình chỉ cần modul vẽ móng và mc móng thôi

[lythang 0]

Chào bạn. Mình có một vấn đề muốn nhờ bạn giải quyết hộ.

 

- Mình đang làm công tác về đo đạc phân lô nền khu dân cư, lập bản đồ địa chính. Mình đang dùng soft MicroStation SE của tổng cục địa chính ban hành. Nhưng khi đo đạc có số liệu xong rồi mình thường dùng Cad để vẽ (Cad và MicroStation SE có thể hổ trợ lẫn nhau). Nhưng khi vẽ trên Cad xong (vẽ trên nhiều lớp trên Cad,) mình xuất ra file *.dfx để dùng MicroStation SE để làm bản đồ địa chính bổ sung. Nhưng MicroStation SE không thể nhận lớp từ Cad mà nó chỉ dồn về 1 lớp trong SE.

 

- Em muốn có lisp nào khi thiết kế trên CAd xong thì load lsip đó để convert qua SE thì lớp nào ra lớp đó.

 

- Mong anh giúp đở giùm.

[ketxu 3005]

Lisp vẽ móng BTCT ^^ Bạn nào có không, mình chỉ cần modul vẽ móng và mc móng thôi

Nếu mình nhớ không nhầm thì có trong bộ Fastcad, bạn tìm kiếm xem sao.

Góp ý bạn : mỗi cty một ISO vẽ riêng , những yêu cầu chung chung như thế này là câu hỏi hàng triệu người vẫn đang đau đầu giải quyết, nên nếu có, cũng chỉ là để bạn tham khảo và edit trong khả năng. Mình đã theo dõi topic Tổng hợp lisp XDDD và nhờ sửa của bạn, nên thiết nghĩ bạn cũng nên vọc với lisp một chút để có khả năng tùy biến theo ý của mình.Chúc bạn vui

[ketxu 3005]

Chào bạn. Mình có một vấn đề muốn nhờ bạn giải quyết hộ.

 

- Mình đang làm công tác về đo đạc phân lô nền khu dân cư, lập bản đồ địa chính. Mình đang dùng soft MicroStation SE của tổng cục địa chính ban hành. Nhưng khi đo đạc có số liệu xong rồi mình thường dùng Cad để vẽ (Cad và MicroStation SE có thể hổ trợ lẫn nhau). Nhưng khi vẽ trên Cad xong (vẽ trên nhiều lớp trên Cad,) mình xuất ra file *.dfx để dùng MicroStation SE để làm bản đồ địa chính bổ sung. Nhưng MicroStation SE không thể nhận lớp từ Cad mà nó chỉ dồn về 1 lớp trong SE.

 

- Em muốn có lisp nào khi thiết kế trên CAd xong thì load lsip đó để convert qua SE thì lớp nào ra lớp đó.

 

- Mong anh giúp đở giùm.

Hok biết bạn lythang hỏi ai, nhưng mình cũng muốn hỏi bạn 1 câu ntn : Bạn đã có ý niệm cái "lisp" làm việc đó sẽ làm việc trên môi trường nào chưa :).

Vấn đề : CAD đã xuất ra *.dfx bình thường -> SE đọc lại k nhận lớp -> vấn đề ở thằng SE -> "lisp" trong SE.Còn việc SE có hỗ trợ làm cái "lisp" không thì mình hok chắc :)

Hơn nữa, phần mềm SE của CỤC đó, mình chưa được ngó qua, chắc nhiều người trên đây cũng vậy :)

[lythang 0]

Hok biết bạn lythang hỏi ai, nhưng mình cũng muốn hỏi bạn 1 câu ntn : Bạn đã có ý niệm cái "lisp" làm việc đó sẽ làm việc trên môi trường nào chưa :).

Vấn đề : CAD đã xuất ra *.dfx bình thường -> SE đọc lại k nhận lớp -> vấn đề ở thằng SE -> "lisp" trong SE.Còn việc SE có hỗ trợ làm cái "lisp" không thì mình hok chắc :)

Hơn nữa, phần mềm SE của CỤC đó, mình chưa được ngó qua, chắc nhiều người trên đây cũng vậy :)

SE là phần mềm biên tập bản đồ. Dù sao cũng Thanks anh KetXu. Mong là có anh em nào củng cảnh ngộ như mình thì giúp giùm.

[phamthanhbinh 3149]

Chào bạn. Mình có một vấn đề muốn nhờ bạn giải quyết hộ.

 

- Mình đang làm công tác về đo đạc phân lô nền khu dân cư, lập bản đồ địa chính. Mình đang dùng soft MicroStation SE của tổng cục địa chính ban hành. Nhưng khi đo đạc có số liệu xong rồi mình thường dùng Cad để vẽ (Cad và MicroStation SE có thể hổ trợ lẫn nhau). Nhưng khi vẽ trên Cad xong (vẽ trên nhiều lớp trên Cad,) mình xuất ra file *.dfx để dùng MicroStation SE để làm bản đồ địa chính bổ sung. Nhưng MicroStation SE không thể nhận lớp từ Cad mà nó chỉ dồn về 1 lớp trong SE.

 

- Em muốn có lisp nào khi thiết kế trên CAd xong thì load lsip đó để convert qua SE thì lớp nào ra lớp đó.

 

- Mong anh giúp đở giùm.

Hề hề hề,

Bạn thử làm cách này xem sao:

1/- Xuất thành các bản vẽ CAD độc lập mà mỗi bản chỉ chứa 1 hay vài lớp mà bạn cần

2/- Xuất các thằng này sang cái mícrostation SE của bạn.

 

Hy vọng bạn thành công...

Chỉnh sửa Tháng 2 8, 2011 theo phamthanhbinh
Lỗi chính tả

[ketxu 3005]

Hoặc là bạn thử block toàn bộ file xem sao ? liệu cho nó vào 1 đối tượng như thế nó còn chuyển qua 1 layer nữa không? Mình nghĩ cũng không khả thi lắm, vì đó là cách quản lý của nó rồi

[LiveView 5]

Mình đang cần 1 lisp chon tất cả các block trong bản vẽ (mình đã search rồi nhưng chỉ có lisp chọn các block có tên giống nhau) & 1 lisp chọn tất cả các đối tượng Dim trong bản vẽ. Vui lòng giúp mình nhe. Thanks ! :s_big:

[phamngoctukts 717]

Mình đang cần 1 lisp chon tất cả các block trong bản vẽ (mình đã search rồi nhưng chỉ có lisp chọn các block có tên giống nhau) & 1 lisp chọn tất cả các đối tượng Dim trong bản vẽ. Vui lòng giúp mình nhe. Thanks ! :s_big:

Bạn làm như sau không cần lisp liếc gì đâu

chọn block (tại dòng command gõ như sau)

command:(ssget "x" '((0 . "INSERT")))

command:(command "select" "p")

chọn dim

command:(ssget "x" '((0 . "DIMENSION")))

command:(command "select" "p")

[TRUNGNGAMY 91]

Chào bạn. Mình có một vấn đề muốn nhờ bạn giải quyết hộ.

 

- Mình đang làm công tác về đo đạc phân lô nền khu dân cư, lập bản đồ địa chính. Mình đang dùng soft MicroStation SE của tổng cục địa chính ban hành. Nhưng khi đo đạc có số liệu xong rồi mình thường dùng Cad để vẽ (Cad và MicroStation SE có thể hổ trợ lẫn nhau). Nhưng khi vẽ trên Cad xong (vẽ trên nhiều lớp trên Cad,) mình xuất ra file *.dfx để dùng MicroStation SE để làm bản đồ địa chính bổ sung. Nhưng MicroStation SE không thể nhận lớp từ Cad mà nó chỉ dồn về 1 lớp trong SE.

 

- Em muốn có lisp nào khi thiết kế trên CAd xong thì load lsip đó để convert qua SE thì lớp nào ra lớp đó.

 

- Mong anh giúp đở giùm.

Theo như mình biết, Micỏtation SE chỉ cho tạo 63 layer và chỉ nhận tên layer dạng số. Muốn Mic hiểu đc tên layer từ cad thì bạn phải khai báo thêm trong file dwglevel.tbl có trong một đường dẫn nào đó của thư mục cài đặt Mic (mình cũng ít làm nên kg nhớ), trong đó đã có hướng dẫn. Đại khái như sau :

[tenlayercad] [tenlayerMic]

Ví dụ :

1 1

2 2

Ranhdat 10

(chú ý : Mic SE chỉ nhận tên layer của cad tối đa 7 ký tự)

[Tue_NV 3916]

Mình đang cần 1 lisp chon tất cả các block trong bản vẽ (mình đã search rồi nhưng chỉ có lisp chọn các block có tên giống nhau) & 1 lisp chọn tất cả các đối tượng Dim trong bản vẽ. Vui lòng giúp mình nhe. Thanks ! :s_big:

Sao bạn không sử dụng lệnh Filter hay là Quick select hoặc là lệnh SSX?