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

Xin Lisp Tự Động Đo Chiều Dài Nhiều Line (Ko Tính Tổng)

Bởi AndUp , trong AutoLisp

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

AndUp    1

AndUp
Đã đăng

ví dụ em có 100 đường line rời rạc nằm đủ kiểu khác nhau nếu ngồi dim từng đường rất lâu nên nhờ các bác viết giúp em lisp chỉ cần quét qua tất cả các line là sẽ tự cho ra kết quả chiều dài của từng line, kết quả có thể trình bày theo dạng đường dim cũng được (nằm sát đường line ) hoặc dạng text sao cho text nằm trên đường line (không đè cắt ngang đường line) và góc quay của text cùng góc với từng đường line (text nằm song song ấ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

ketxu    2.984

ketxu
Đã đăng

Quick code cho bạn :

(defun c:qdd(/ s sp 3d i dxf rAng rSup e obj) (vl-load-com)
;Quick dim Lines @ketxu 10/2016
(cond
	((setq s (ssget '((0 . "LINE")))) 
	(setq 	sp	(vlax-get (setq ac (vla-get-activedocument (vlax-get-acad-object)))
					(if (> (vla-get-activespace  ac) 0) 'ModelSpace 'PaperSpace)) 
			3d vlax-3d-point
			i -1
			dxf (lambda(i e)(cdr (assoc i (entget e))))
			rAng (lambda(a)(if (and (> a (/ pi 2.)) (<= a (* pi 1.5)))(+ a pi) a))
			rSup (lambda(p)(vlax-put-property obj p 1))
			
	)
	(while (setq e (ssname s (setq i (1+ i))))
			(setq obj 
				(vla-adddimaligned sp 
					(3d (setq p1 (dxf 10 e))) 
                    (3d (setq p2 (dxf 11 e)))     
					(3d (polar p1 (+ (angle p1 p2) (/ pi 2.)) 0))
                )			
			)
			(vla-put-Textrotation obj (rAng (angle p1 p2)))
			(vla-put-TextOverride obj "<>\\P   ")
			(mapcar 'rSup '(DimLine1Suppress DimLine2Suppress ExtLine1Suppress ExtLine2Suppress))
	)	
)
))
  • Like 2
  • Vote tăng 3

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

AndUp    1

AndUp
Đã đăng

Tks bác sẳn cho em hỏi trong đoạn code sau em sai chỗ nào với ạ

(Setq a (getstring "\n Nhập tên lô đất")

B (getreal "\n nhập số bắt đầu)

C 0)

(While

(Setq d (strcat a (+ b c))

C (+ c 1))

)

(Princ d) -> tới đây thì báo lỗ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

ketxu    2.984

ketxu
Đã đăng

Strcat yêu cầu đối số là các string. Trong đây bạn lại có tổng của b + c = số thực.

Ngoài ra hàm while của bạn đang không có điều kiện thoát

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

ketxu    2.984

ketxu
Đã đăng

Itoa lại là hàm chuyển đổi Integer sang String, trong khi b của bạn là Getreal => Kiểu số Real. (+ b c) trả về Real => lỗi

Khi sử dụng các hàm bạn phải chú ý yêu cầu về đối số của nó để cung cấp cho đúng, đừng vội vàng

  • Like 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

quanghuy181    0

quanghuy181
Đã đăng

 

Quick code cho bạn :

(defun c:qdd(/ s sp 3d i dxf rAng rSup e obj) (vl-load-com)
;Quick dim Lines @ketxu 10/2016
(cond
	((setq s (ssget '((0 . "LINE")))) 
	(setq 	sp	(vlax-get (setq ac (vla-get-activedocument (vlax-get-acad-object)))
					(if (> (vla-get-activespace  ac) 0) 'ModelSpace 'PaperSpace)) 
			3d vlax-3d-point
			i -1
			dxf (lambda(i e)(cdr (assoc i (entget e))))
			rAng (lambda(a)(if (and (> a (/ pi 2.)) (<= a (* pi 1.5)))(+ a pi) a))
			rSup (lambda(p)(vlax-put-property obj p 1))
			
	)
	(while (setq e (ssname s (setq i (1+ i))))
			(setq obj 
				(vla-adddimaligned sp 
					(3d (setq p1 (dxf 10 e))) 
                    (3d (setq p2 (dxf 11 e)))     
					(3d (polar p1 (+ (angle p1 p2) (/ pi 2.)) 0))
                )			
			)
			(vla-put-Textrotation obj (rAng (angle p1 p2)))
			(vla-put-TextOverride obj "<>\\P   ")
			(mapcar 'rSup '(DimLine1Suppress DimLine2Suppress ExtLine1Suppress ExtLine2Suppress))
	)	
)
))

Bạn ơi mình muốn chiều dài cạnh chỉ lấy 1 số sau dấu , và chọn nhập chiều cao chữ thì làm như thế nào??? Xin cảm ơn!

  • Vote giảm 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

Danh Cong    422

Danh Cong
Đã đăng

Bạn ơi mình muốn chiều dài cạnh chỉ lấy 1 số sau dấu , và chọn nhập chiều cao chữ thì làm như thế nào??? Xin cảm ơn!

 

"Text" bạn nhìn thấy thực chất là các đường dimention kích thước do bác @KetXu đã ẩn đi các đường gióng rồi.

 Muốn thay đổi số sau dấu phẩy hay là chiều cao chữ thì cứ vào "Dimention Style" hiện tại mà thay đổi theo ý thích thôi.  :D :D

  • Like 1
  • 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

pirates0511    4

pirates0511
Đã đăng

nhờ các bác sửa giúp lại cái lips ghi độ dài trên em với. em muốn nó:

1. ghi với cả nét Polyline (lips trên chỉ ghi với Line),

2. chữ dạng text cao 3,5 (không phải dim)

3. là 1 layer mới (ví dụ layer "ghi kích thước" và có màu đỏ) để tiện ẩn đi.

  • Vote giảm 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

Thanh TV    2

Thanh TV
Đã đăng

 

Vào lúc 28/10/2016 tại 08:57, ketxu đã nói:

Quick code cho bạn : 

Nhờ bác sửa giúp lại cái lips ghi độ dài trên sử dụng với cả nét Polyline và MLINE (lips trên chỉ ghi với Line).

Cám ơn bác nhiều ạ 


(defun c:qdd(/ s sp 3d i dxf rAng rSup e obj) (vl-load-com)
;Quick dim Lines @ketxu 10/2016
(cond
	((setq s (ssget '((0 . "LINE")))) 
	(setq 	sp	(vlax-get (setq ac (vla-get-activedocument (vlax-get-acad-object)))
					(if (> (vla-get-activespace  ac) 0) 'ModelSpace 'PaperSpace)) 
			3d vlax-3d-point
			i -1
			dxf (lambda(i e)(cdr (assoc i (entget e))))
			rAng (lambda(a)(if (and (> a (/ pi 2.)) (<= a (* pi 1.5)))(+ a pi) a))
			rSup (lambda(p)(vlax-put-property obj p 1))
			
	)
	(while (setq e (ssname s (setq i (1+ i))))
			(setq obj 
				(vla-adddimaligned sp 
					(3d (setq p1 (dxf 10 e))) 
                    (3d (setq p2 (dxf 11 e)))     
					(3d (polar p1 (+ (angle p1 p2) (/ pi 2.)) 0))
                )			
			)
			(vla-put-Textrotation obj (rAng (angle p1 p2)))
			(vla-put-TextOverride obj "<>\\P   ")
			(mapcar 'rSup '(DimLine1Suppress DimLine2Suppress ExtLine1Suppress ExtLine2Suppress))
	)	
)
))

 

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

dinhvantrang    151

dinhvantrang
Đã đăng
Vừa xong, kienxd04 đã nói:

đúng cái này rồi bạn, nó xem được cả arc được phải không bạn?

 

Arc hoặc Spline thì cũng được, nhưng vị trí ghi thì mình chưa biết bố trí thế nào nên không cho vào

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

dinhvantrang    151

dinhvantrang
Đã đăng
4 giờ trước, kienxd04 đã nói:

vậy ok quá, bạn share mình với nếu bạn cho phép nhé, mình cảm ơn.

 

Mình đang trong quá trình hoàn thiện nó, đang nâng cấp nó lên để có thể show được chiều dài của Arc, chiều dài của Arc trong một Polyline.

Do chưa hoàn thiện nên chưa share được. Mong bạn thông cảm

  • Like 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

hatrongquan88    4

hatrongquan88
Đã đăng
Vào lúc 2/11/2016 tại 16:23, Danh Cong đã nói:

 

"Text" bạn nhìn thấy thực chất là các đường dimention kích thước do bác @KetXu đã ẩn đi các đường gióng rồi.

 Muốn thay đổi số sau dấu phẩy hay là chiều cao chữ thì cứ vào "Dimention Style" hiện tại mà thay đổi theo ý thích thôi.  :D :D

Nhờ bạn hướng dẫn giúp mình muốn cho hiện đường gióng lên thì làm như thế nào vậ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

Danh Cong    422

Danh Cong
Đã đăng
54 phút trước, hatrongquan88 đã nói:

Nhờ bạn hướng dẫn giúp mình muốn cho hiện đường gióng lên thì làm như thế nào vậy?

+ Bạn dùng lệnh "MATCHPROP".

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

tranhieu.kisuxaydung    5

tranhieu.kisuxaydung
Đã đăng
Vào lúc 28/10/2016 tại 08:57, ketxu đã nói:

Quick code cho bạn : 


(defun c:qdd(/ s sp 3d i dxf rAng rSup e obj) (vl-load-com)
;Quick dim Lines @ketxu 10/2016
(cond
	((setq s (ssget '((0 . "LINE")))) 
	(setq 	sp	(vlax-get (setq ac (vla-get-activedocument (vlax-get-acad-object)))
					(if (> (vla-get-activespace  ac) 0) 'ModelSpace 'PaperSpace)) 
			3d vlax-3d-point
			i -1
			dxf (lambda(i e)(cdr (assoc i (entget e))))
			rAng (lambda(a)(if (and (> a (/ pi 2.)) (<= a (* pi 1.5)))(+ a pi) a))
			rSup (lambda(p)(vlax-put-property obj p 1))
			
	)
	(while (setq e (ssname s (setq i (1+ i))))
			(setq obj 
				(vla-adddimaligned sp 
					(3d (setq p1 (dxf 10 e))) 
                    (3d (setq p2 (dxf 11 e)))     
					(3d (polar p1 (+ (angle p1 p2) (/ pi 2.)) 0))
                )			
			)
			(vla-put-Textrotation obj (rAng (angle p1 p2)))
			(vla-put-TextOverride obj "<>\\P   ")
			(mapcar 'rSup '(DimLine1Suppress DimLine2Suppress ExtLine1Suppress ExtLine2Suppress))
	)	
)
))

Lisp cực hữu ích. cảm ơn bro nhé

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

nh0kdkny    2

nh0kdkny
Đã đăng
Vào lúc 28/10/2016 tại 08:57, ketxu đã nói:

Quick code cho bạn : 


(defun c:qdd(/ s sp 3d i dxf rAng rSup e obj) (vl-load-com)
;Quick dim Lines @ketxu 10/2016
(cond
	((setq s (ssget '((0 . "LINE")))) 
	(setq 	sp	(vlax-get (setq ac (vla-get-activedocument (vlax-get-acad-object)))
					(if (> (vla-get-activespace  ac) 0) 'ModelSpace 'PaperSpace)) 
			3d vlax-3d-point
			i -1
			dxf (lambda(i e)(cdr (assoc i (entget e))))
			rAng (lambda(a)(if (and (> a (/ pi 2.)) (<= a (* pi 1.5)))(+ a pi) a))
			rSup (lambda(p)(vlax-put-property obj p 1))
			
	)
	(while (setq e (ssname s (setq i (1+ i))))
			(setq obj 
				(vla-adddimaligned sp 
					(3d (setq p1 (dxf 10 e))) 
                    (3d (setq p2 (dxf 11 e)))     
					(3d (polar p1 (+ (angle p1 p2) (/ pi 2.)) 0))
                )			
			)
			(vla-put-Textrotation obj (rAng (angle p1 p2)))
			(vla-put-TextOverride obj "<>\\P   ")
			(mapcar 'rSup '(DimLine1Suppress DimLine2Suppress ExtLine1Suppress ExtLine2Suppress))
	)	
)
))

em muốn dim khoảng cách giữa các block mình chọn giữa 2 điểm chèn block thì không biết từ lisp này có thêm ddc chức năng vậy không bác @ketxu

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

hoành    1

hoành
Đã đăng

chào bác nhờ bác viết cho em lisp với yêu cầu như này với ạ: em có 1 ranh giới kín, nhưng trong đó có 1 số vùng hatch nó tràn ra ngoài, giờ em muốn xóa những phần hatch ở ngoài ranh kia, còn phần trong ranh vẫn giữ lại.  

image.png

image.png

  • Vote giảm 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
Về Đầu Trang AutoLisp
×