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

[Yêu cầu] viết lisp đánh số các đọan thẳng?

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

h luôn bằng 250 còn vòng tròn đường kính là 600 bạn ah,cho mình hỏi cái này không đánh số được cho polyline sao bạn?Nhờ bạn thêm chức năng đánh số cho polyline giùm mình luôn nhe.

Anh chàng Quan08 này đề nghị bỏ xiền mời ket bia cho anh em viết lisp đi. Yêu cầu hơi nhiều và luồn lách, lươn lẹo lắm đó. :D

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

Được, nhưng mà không vui bạn ạ :)

Chắc phải chờ bạn 1 thời gian để bạn nghĩ ra còn yêu cầu nào với lisp này nữa không. Hơn nữa, bạn cũng có tính là nếu Pline có nhiều phân đoạn thì lisp sẽ làm như thế nào không ? Chiều dài lấy theo cái nào? Ghi chữ vào đâu ??

Nên e mới thấy bài của bác Bình là đáp ứng những cái e cần.E chỉ cần có nhiêu đó thôi đó thôi bác ketxu thôi.

PS:Bác Bình xem giùm chỗ lisp bị ngược giùm e chưa 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

Nên e mới thấy bài của bác Bình là đáp ứng những cái e cần.E chỉ cần có nhiêu đó thôi đó thôi bác ketxu thôi.

PS:Bác Bình xem giùm chỗ lisp bị ngược giùm e chưa bác?

Ok bạn :) Chắc bác Bình sẽ giúp bạn sớm thôi

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

Hề hề hề,

Lỗi không phải do lisp mà lỗi do cái bản vẽ của bạn quy định ngược với thông thường, nghĩa là góc quay dương được tính theo chiều kim đồng hồ bạn ạ. Nó chả phải ngược vài cái như bạn nói mà sẽ ngược toàn bộ đối với các line theo phương y.

Bạn hãy xem cái bạn đã đặt cho bản vẽ của bạn:

http://www.cadviet.com/upfiles/3/v1.jpg

v1.jpg

Bạn muốn nó hết ngược thì hãy đổi lại việc thiết lập này nhé. Nếu không bạn sẽ phải thay đổi đoạn code (setq goc "90") thành (setq goc "-90") và ngược lại tùy từng bản vẽ của bạn.

Chúc bạn vui.

  • 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

@Bác Bình : với các lisp có xài đến góc, hướng, tốt nhất là nên đặt angdir và angbase về 0 trước bác ạ :) Chắc chắn sau lần này bạn chủ topic sẽ ưng cái bụng thôi ^^

 

 

 

--------------------------------------

Post lại bài trên vừa nãy ket nhỡ tay xóa

 

h luôn bằng 250 còn vòng tròn đường kính là 600 bạn ah,cho mình hỏi cái này không đánh số được cho polyline sao bạn?Nhờ bạn thêm chức năng đánh số cho polyline giùm mình luôn nhe.

Mình lại tự trả lời câu mình hỏi thôi.

Lần này lisp sẽ :

- Hỏi tên Block dùng để đánh STT, nếu có rồi thì dùng, chưa có thì tạo mới, lần thứ 2 dùng sẽ không hỏi lại (như cũ)

- CHọn *Line (Line,Pline,LWPolyline, SPline..)

=> Lisp sẽ đánh số lần lượt :

1.*Line ngang trước (định nghĩa Ngang nếu Toạ độ Y điểm đầu = Toạ độ Y "trọng tâm"), đánh từ dưới lên.

2.*Line đứng (định nghĩa đứng nếu Toạ độ X điểm đầu = Toạ độ X "trọng tâm"), đánh từ trái sang

3.Các *Line còn lại, đánh từ trái sang

Điểm đánh là "trọng tâm", lấy theo boundingbox

 

(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 mid dau giua)
(defun dxf (dxfCode En) (cdr (assoc dxfCode (entget en))))
(defun mid (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
			p2 (vlax-safearray->list p2)
			pt (mapcar '+ p1 p2)
			pt (mapcar '* pt '(0.5 0.5 0.5))
)
pt
)
(command "undo" "be")
(grtext -1 "Free from CADVIET @ketxu")
(acet-sysvar-set (list "attreq" 1 "attdia" 0 "cmdecho" 0 "osmode" 0 "angbase" 0 "angdir" 0))
(if (or (not #blkname)(= #blkname "" )) (setq #blkname (getstring "\nNh\U+1EADp t\U+00EAn Block :")))
(setq d (tblsearch "style" (getvar "textstyle")) h1 (cdr (assoc 40 d)) h2 (cdr (assoc 42 d)))
(if (> h1 0) (setq h h1) (setq h h2))
;Neu khong co Block ten #blkName : tao moi
(if (not (tblsearch "block" #blkName))
(progn	
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) h "0" )
(setq e1 (entlast))
(command "circle" '(0 0 0) h)
(setq e2 (entlast))
(command "block" #blkName (list 0 (- h) 0) e1 e2 "" )
)
)
;Lay list		
(setq lstEname (acet-ss-to-list (ssget '((0 . "*LINE")))) lstLen '())
(foreach en lstEname	
(setq dau (vlax-curve-getStartPoint (vlax-ename->vla-object en)) giua (mid en))
(cond 
	((equal (cadr dau)(cadr giua) 0.1)
		(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))
	((equal (car dau)(car giua) 0.1)
		(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))
	(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))
)
)		 
;Sap xep :
(setq lstEname
(append
	(vl-sort lstNgang '(lambda (y1 y2) (< (cadr (mid y1)) (cadr (mid y2)))))
	(vl-sort lstDoc '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
	(vl-sort lstkhac '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
)			
str (getstring "\nD\U+00E3y b\U+1EAFt \U+0111\U+1EA7u :") j (1- (atoi str )) i (1+ j)  after (vl-string-left-trim (rtos i 2 0) str)
)
(foreach ent lstEname
(if	(vl-position ent lstDoc)(setq goc 90)(setq goc 0))			
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (not (vl-position len lstLen))
	(progn					
		(command "insert"  #blkname  (mid ent) 1 1 goc (strcat (rtos i 2 0) after))
		(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
	)
	(command "insert"  #blkname  (mid ent) 1 1 goc (strcat (rtos (+ j (1+ (vl-position  len lstLen))) 2 0) after))
)
)
(acet-sysvar-restore)
(command "undo" "en")
)

Chú ý để giữ tính tiện dụng mình không đổi h = 250, đường kính = 600. Nếu bạn cần đổi, hãy thay 3 dòng sau :

(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) h "0" )

..

(command "circle" '(0 0 0) h)

..

(command "block" #blkName (list 0 (- h) 0) e1 e2 "" )

thành :

(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) 250 "0" )

..

(command "circle" '(0 0 0) 300)

..

(command "block" #blkName (list 0 (- 300) 0) e1 e2 "" )

  • Vote tăng 2

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ác Bình : với các lisp có xài đến góc, hướng, tốt nhất là nên đặt angdir và angbase về 0 trước bác ạ :) Chắc chắn sau lần này bạn chủ topic sẽ ưng cái bụng thôi ^^

 

 

 

--------------------------------------

 

Hề hề hề,

Cám ơn Ketxu,

Thực tình mình nhớ là có biến hệ thống quản lý cái ni nhưng chả nhớ tên nó là chi nên lười tìm và post hình ảnh để bạn ấy tự giải quyết.

hề hề hề,

  • 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

Cảm ơn bác Bình và bác ketxu đã nhiệt tình giúp e.Nếu có dịp gặp nhau e sẵn sàng mời bia vì đã làm phiền 2 bác quá nhiều.

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

Cảm ơn bác Bình và bác ketxu đã nhiệt tình giúp e.Nếu có dịp gặp nhau e sẵn sàng mời bia vì đã làm phiền 2 bác quá nhiều.

Hề hề hề. Phải thế chứ, nhưng mà 2 bác ấy một ở HN, 1 bác ở Bình Dương, chắc uống bia muốn "cạng" cheer cheer thì phải "Hôn môi xa rồi". Kekekeke.

p/s: Bác Bình trở lại, lợi hại gấp trăm lần. Hiiii

P/s: Ketxu đâu có uống bia được nhở. :blush:

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ác Bình : với các lisp có xài đến góc, hướng, tốt nhất là nên đặt angdir và angbase về 0 trước bác ạ :) Chắc chắn sau lần này bạn chủ topic sẽ ưng cái bụng thôi ^^

 

 

 

--------------------------------------

Post lại bài trên vừa nãy ket nhỡ tay xóa

 

 

Mình lại tự trả lời câu mình hỏi thôi.

Lần này lisp sẽ :

- Hỏi tên Block dùng để đánh STT, nếu có rồi thì dùng, chưa có thì tạo mới, lần thứ 2 dùng sẽ không hỏi lại (như cũ)

- CHọn *Line (Line,Pline,LWPolyline, SPline..)

=> Lisp sẽ đánh số lần lượt :

1.*Line ngang trước (định nghĩa Ngang nếu Toạ độ Y điểm đầu = Toạ độ Y "trọng tâm"), đánh từ dưới lên.

2.*Line đứng (định nghĩa đứng nếu Toạ độ X điểm đầu = Toạ độ X "trọng tâm"), đánh từ trái sang

3.Các *Line còn lại, đánh từ trái sang

Điểm đánh là "trọng tâm", lấy theo boundingbox

 

(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 mid dau giua)
(defun dxf (dxfCode En) (cdr (assoc dxfCode (entget en))))
(defun mid (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
			p2 (vlax-safearray->list p2)
			pt (mapcar '+ p1 p2)
			pt (mapcar '* pt '(0.5 0.5 0.5))
)
pt
)
(command "undo" "be")
(grtext -1 "Free from CADVIET @ketxu")
(acet-sysvar-set (list "attreq" 1 "attdia" 0 "cmdecho" 0 "osmode" 0 "angbase" 0 "angdir" 0))
(if (or (not #blkname)(= #blkname "" )) (setq #blkname (getstring "\nNh\U+1EADp t\U+00EAn Block :")))
(setq d (tblsearch "style" (getvar "textstyle")) h1 (cdr (assoc 40 d)) h2 (cdr (assoc 42 d)))
(if (> h1 0) (setq h h1) (setq h h2))
;Neu khong co Block ten #blkName : tao moi
(if (not (tblsearch "block" #blkName))
(progn	
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) h "0" )
(setq e1 (entlast))
(command "circle" '(0 0 0) h)
(setq e2 (entlast))
(command "block" #blkName (list 0 (- h) 0) e1 e2 "" )
)
)
;Lay list		
(setq lstEname (acet-ss-to-list (ssget '((0 . "*LINE")))) lstLen '())
(foreach en lstEname	
(setq dau (vlax-curve-getStartPoint (vlax-ename->vla-object en)) giua (mid en))
(cond 
	((equal (cadr dau)(cadr giua) 0.1)
		(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))
	((equal (car dau)(car giua) 0.1)
		(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))
	(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))
)
)		 
;Sap xep :
(setq lstEname
(append
	(vl-sort lstNgang '(lambda (y1 y2) (< (cadr (mid y1)) (cadr (mid y2)))))
	(vl-sort lstDoc '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
	(vl-sort lstkhac '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
)			
str (getstring "\nD\U+00E3y b\U+1EAFt \U+0111\U+1EA7u :") j (1- (atoi str )) i (1+ j)  after (vl-string-left-trim (rtos i 2 0) str)
)
(foreach ent lstEname
(if	(vl-position ent lstDoc)(setq goc 90)(setq goc 0))			
(setq len (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
(if (not (vl-position len lstLen))
	(progn					
		(command "insert"  #blkname  (mid ent) 1 1 goc (strcat (rtos i 2 0) after))
		(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
	)
	(command "insert"  #blkname  (mid ent) 1 1 goc (strcat (rtos (+ j (1+ (vl-position  len lstLen))) 2 0) after))
)
)
(acet-sysvar-restore)
(command "undo" "en")
)

Chú ý để giữ tính tiện dụng mình không đổi h = 250, đường kính = 600. Nếu bạn cần đổi, hãy thay 3 dòng sau :

 

thành :

Lisp của bác rất hay,nhưng lisp này lấy TEXT STYLE mặc định của cad là STANDARD,giờ mình muốn nó lấy TEXT STYLE do mình định nghĩa là FONTCHU thì phải làm sao?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

Lisp sử dụng Style hiện tại, bạn để style hiện hành là gì thì nó lấy cái đó!

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

Lisp sử dụng Style hiện tại, bạn để style hiện hành là gì thì nó lấy cái đó!

Lisp của bạn chạy tốt nhưng khi mình dùng Vlide để kiểm lỗi:

; warning: local variable used as function: MID

Vậy lỗi này là lỗi gì vậy bạn?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

Lisp của bạn chạy tốt nhưng khi mình dùng Vlide để kiểm lỗi:

; warning: local variable used as function: MID

Vậy lỗi này là lỗi gì vậy bạn?Thanks.

Có lẽ bác Ketxu đã nhầm khi lấy tên hàm làm biến cục bộ ấy mà. Bạn bỏ "mid" trong các biến cục bộ đi là đượ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

Có lẽ bác Ketxu đã nhầm khi lấy tên hàm làm biến cục bộ ấy mà. Bạn bỏ "mid" trong các biến cục bộ đi là được.

Bác nào sửa giùm e với.E đã thử đổi tên MID thành tên khác thì vẫn báo lỗi tên mới giống tên cũ.Nếu bỏ EN đi thì nó báo tới EN.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

Lisp của bác rất hay,nhưng lisp này lấy TEXT STYLE mặc định của cad là STANDARD,giờ mình muốn nó lấy TEXT STYLE do mình định nghĩa là FONTCHU thì phải làm sao?Thanks.

Hề hề hề,

Chơi kiểu bác ketxu cũng hay. Nếu không muốn bạn có thể thêm "s" "Fontchu" vào trước "j" trong hàm tạo attdef.

Hề hề hề.

  • 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

Bác nào sửa giùm e với.E đã thử đổi tên MID thành tên khác thì vẫn báo lỗi tên mới giống tên cũ.Nếu bỏ EN đi thì nó báo tới EN.Thanks.

Hề hề hề,

Bạn cứ làm đúng như bác ĐoanvanHa đã dạy, chớ bạn đổi cả tên biến lẫn tên hàm thì có ich chi đâu.... Chỉ xóa cái biến mid trong số các biến cục bộ mà thôi, còn thì cứ để U NHƯ KỴ.

Hề hề hề,...

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

Lisp của bạn chạy tốt nhưng khi mình dùng Vlide để kiểm lỗi:

; warning: local variable used as function: MID

Vậy lỗi này là lỗi gì vậy bạn?Thanks.

 

Bác nào sửa giùm e với.E đã thử đổi tên MID thành tên khác thì vẫn báo lỗi tên mới giống tên cũ.Nếu bỏ EN đi thì nó báo tới EN.Thanks.

 

Ồ, bạn bắt đầu lập trình, hay mần chi mà "kiểm lỗi" :) Và bỏ mid, bỏ en ở đâu ???

 

Có lẽ bác Ketxu đã nhầm khi lấy tên hàm làm biến cục bộ ấy mà. Bạn bỏ "mid" trong các biến cục bộ đi là được.

Em cố ý đó bác ạ :) Có 1 số lý do mà không phải lúc nào cũng dùng lambda, và khi đó thì cần làm như thế này :)

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ác nào sửa giùm e với.E đã thử đổi tên MID thành tên khác thì vẫn báo lỗi tên mới giống tên cũ.Nếu bỏ EN đi thì nó báo tới EN.Thanks.

Sao lại đổi tên mid? Bạn chỉ sửa:

(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 mid dau giua)

thành

(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 dau giua)

Tôi đã thử, được mà.

P/S: ồ, té ra là cố ý của ketxu. Hì, hì, hì!

  • 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

Để các hàm dxf,mid chỉ có tác dụng khi chạy lisp này :)

P/s : hàm dxf không còn cần trong lisp 2, nên có thể xóa đi ^^

  • 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

Nhờ bạn ketxu xem giùm mình nếu đoạn thẳng như thế này thì đánh không đúng.Mong bạn xem và giúp sửa giùm mình.Thanks.

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

Hề hề hề,

Lisp chạy rất chuẩn theo ý của người viết. Chỉ có hình vẽ của bạn sai với cái yêu cầu đặt ra ban đầu mà thôi.

Bạn hãy kiểm tra lại nhé......

Còn nếu bạn muốn sử dụng nó trong trường hợp hình vẽ của bạn thì phải thay cái đoạn code này đi bạn nhé:

(cond

((equal (cadr dau)(cadr giua) 0.1)

(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))

((equal (car dau)(car giua) 0.1)

(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))

(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))

)

Hề hề hề,...

  • 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

Hề hề hề,

Lisp chạy rất chuẩn theo ý của người viết. Chỉ có hình vẽ của bạn sai với cái yêu cầu đặt ra ban đầu mà thôi.

Bạn hãy kiểm tra lại nhé......

Còn nếu bạn muốn sử dụng nó trong trường hợp hình vẽ của bạn thì phải thay cái đoạn code này đi bạn nhé:

(cond

((equal (cadr dau)(cadr giua) 0.1)

(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))

((equal (car dau)(car giua) 0.1)

(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))

(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))

)

Hề hề hề,...

Thay như thế nào vậy bác?Bác giúp e luôn với.E về lisp còn amater lắm.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

Thay như thế nào vậy bác?Bác giúp e luôn với.E về lisp còn amater lắm.Thanks.

Hề hề hề,

Bạn thử thay thế này coi sao:

(cond

((equal (cadr (vlax-curve-getfirstderiv (vlax-ename->vla-object en)(/ (vlax-curve-getendparam (vlax-ename->vla-object en)) 2))) 0 0.0001)

(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))

((equal (car (vlax-curve-getfirstderiv (vlax-ename->vla-object en)(/ (vlax-curve-getendparam (vlax-ename->vla-object en)) 2))) 0 0.0001)

(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))

(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))

)

Hề hề hề,

  • 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

Hề hề hề,

Bạn thử thay thế này coi sao:

(cond

((equal (cadr (vlax-curve-getfirstderiv (vlax-ename->vla-object en)(/ (vlax-curve-getendparam (vlax-ename->vla-object en)) 2))) 0 0.0001)

(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))

((equal (car (vlax-curve-getfirstderiv (vlax-ename->vla-object en)(/ (vlax-curve-getendparam (vlax-ename->vla-object en)) 2))) 0 0.0001)

(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))

(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))

)

Hề hề hề,

Còn 1 lỗi nhỏ nữa bác ạ.Mong bác sửa giùm e luôn nhe.Cảm ơn bác nhiều.

http://www.cadviet.com/upfiles/3/drawing1_71.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

Nhờ bạn ketxu xem giùm mình nếu đoạn thẳng như thế này thì đánh không đúng.Mong bạn xem và giúp sửa giùm mình.Thanks.

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

Chính xác là bản vẽ của bạn chả đúng với điều ban đầu bạn nói, hoặc bạn chẳng đọc những dòng ketxu ghi trước khi post lisp.

Lúc đầu thì bạn post toàn Line thẳng, dần dà ra ntn đây. Sao bạn không nói ngay từ đầu ? Sau này lúc nào buồn buồn bạn lại đổi cái form mà lúc đầu bạn gọi là Pline thành các kiểu khác rồi lại lôi cổ ket ra bảo nó làm sai thì ... :blink:

Diễn đàn cứ vận động lisper ghi rõ ý đồ của lisp, mà ghi xong chẳng mấy ai đọc, tốt nhất là cứ post rồi im lặng thôi, bác nào dùng được thì dùng :wub:

 

Về vấn đề của bạn :

- Lisp đánh số sai do lỗi làm tròn của CAD, kiểm tra lstLen sẽ thấy 2 phần tử 5700.0. Vậy, với sai số nhỏ, ta biến chúng thành số nguyên, tức những Pline xấp xỉ nhau (ví dụ 1.1 với 1.3 với 1.9) coi như bằng nhau để đánh số cho đơn giản

Đoạn code viết lại :

(defun c:2(/ lstEname len lstLen i j h h1 h2 after lstNgang lstDoc lstKhac dxf d e1 e2 mid dau giua)
(defun mid (ent / p1 p2)
(vla-getboundingbox (vlax-ename->vla-object ent) 'p1 'p2)
(setq p1 (vlax-safearray->list p1)
			p2 (vlax-safearray->list p2)
			pt (mapcar '+ p1 p2)
			pt (mapcar '* pt '(0.5 0.5 0.5))
)
pt
)
(defun midp ( p1 p2)(mapcar '* (mapcar '+ p1 p2) '(0.5 0.5 0.5)))
(command "undo" "be")
(grtext -1 "Free from CADVIET @ketxu")
(acet-sysvar-set (list "attreq" 1 "attdia" 0 "cmdecho" 0 "osmode" 0 "angbase" 0 "angdir" 0))
(if (or (not #blkname)(= #blkname "" )) (setq #blkname (getstring "\nNh\U+1EADp t\U+00EAn Block :")))
(setq d (tblsearch "style" (getvar "textstyle")) h1 (cdr (assoc 40 d)) h2 (cdr (assoc 42 d)))
(if (> h1 0) (setq h h1) (setq h h2))
;Neu khong co Block ten #blkName : tao moi
(if (not (tblsearch "block" #blkName))
(progn	
(command "attdef" "" "tt" "Nhap so" "" "j" "MC" '(0 0 0) h "0" )
(setq e1 (entlast))
(command "circle" '(0 0 0) h)
(setq e2 (entlast))
(command "block" #blkName (list 0 (- h) 0) e1 e2 "" )
)
)
;Lay list		
(setq lstEname (acet-ss-to-list (ssget '((0 . "*LINE")))) lstLen '())
(foreach en lstEname	
(setq dau (nth (1- (/(length (setq lstPnt (acet-geom-vertex-list en))) 2)) lstPnt) giua (nth  (/(length (setq lstPnt (acet-geom-vertex-list en))) 2) lstPnt)) ;6 (3,4) 4 (2,3)
(cond 
	((equal (cadr dau)(cadr giua) 0.1)
		(setq lstNgang (acet-list-insert-nth en lstNgang (length lstNgang))))
	((equal (car dau)(car giua) 0.1)
		(setq lstDoc (acet-list-insert-nth en lstDoc (length lstDoc))))
	(T (setq lstKhac (acet-list-insert-nth en lstKhac (length lstKhac))))
)
)		 
;Sap xep :
(setq lstEname
(append
	(vl-sort lstNgang '(lambda (y1 y2) (< (cadr (mid y1)) (cadr (mid y2)))))
	(vl-sort lstDoc '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
	(vl-sort lstkhac '(lambda (y1 y2) (< (car (mid y1)) (car (mid y2)))))
)			
str (getstring "\nD\U+00E3y b\U+1EAFt \U+0111\U+1EA7u :") j (1- (atoi str )) i (1+ j)  after (vl-string-left-trim (rtos i 2 0) str)
)
(foreach ent lstEname
(if	(vl-position ent lstDoc)(setq goc 90)(setq goc 0))			
(setq len (fix (vlax-curve-getDistAtParam ent (vlax-curve-getEndParam ent)))
 dau (nth (1- (/(length (setq lstPnt (acet-geom-vertex-list ent))) 2)) lstPnt) giua (nth  (/(length lstPnt) 2) lstPnt))
(if (not (vl-position len lstLen))
	(progn					
		(command "insert"  #blkname  (midp dau giua) 1 1 goc (strcat (rtos i 2 0) after))
		(setq lstLen (reverse (cons len (reverse lstLen ))) i (1+ i))
	)
	(command "insert"  #blkname  (midp dau giua) 1 1 goc (strcat (rtos (+ j (1+ (vl-position  len lstLen))) 2 0) after))
)
)
(acet-sysvar-restore)
(command "undo" "en")
)

  • 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

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


×