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

Nhờ viết lisp: Tạo dim vuông góc giữa hai đường Polyline

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

Chào cả nhà. Em có một vấn đề nhờ cả nhà giúp đỡ.

Em có hai đường Polyline với nhiều điểm khác nhau (File đính kèm). Nhờ các bác viết 1 lisp DIM từ tất cả các đỉnh đường Polyline màu đỏ vuông góc với đường Polyline màu xanh và xuất kết quả DIM ra text hoặc excel theo thứ tự từ 1-27. 

Em cảm ơn các bác nhiều lắm.

So hoa BT phun.dwg

Untitled.jpg

  • 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
8 giờ trước, ketxu cho biết:

Cái này a có viết rồi, 5,6  dòng code chứ mấy ^^ Nhưng với VBA là nhọc hơn đó :D

Anh chia sẻ code được không ? Em không rành về VBA hay lisp gì cả nên khó quá

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Bạn Phamthanhbinh.

1/- Các điểm trên Poly 1 là các đỉnh Poly.

2/- Trật tự các point (là các đỉnh Poly) xếp theo chiều đồng hồ.

Mình nghĩ 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

Quick code cho bạn

;lisp viet theo y/c: http://www.cadviet.com/forum/topic/170671-nh%E1%BB%9D-vi%E1%BA%BFt-lisp-t%E1%BA%A1o-dim-vu%C3%B4ng-g%C3%B3c-gi%E1%BB%AFa-hai-%C4%91%C6%B0%E1%BB%9Dng-polyline/
(defun c:DDD(/ lst_va old plDo plXanh lst_ver fn pw p2 LastObj)
	(setq lst_va '("osmode" "cmdecho"))
	(setq old (mapcar 'getvar lst_va))
	(mapcar 'setvar lst_va '(0 0))
	(setq plDo (car(entsel "\nChon duong mau do: ")))
	(setq plXanh (car(entsel "\nChon duong mau xanh: ")))
	(if (and plDo plXanh)
		(progn
			(setq lst_ver (acet-geom-vertex-list plDo)
				  )
			(if (< (car (last lst_ver)) (car (car lst_ver))) 
				(setq lst_ver (reverse lst_ver))
			)
			(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 			(setq pw (open fn "w"))
			(write-line (strcat "STT, K/cach") pw)	
			(foreach p1 lst_ver
				(setq p2 (vlax-curve-getClosestPointTo plXanh p1))
				(command ".dimaligned" p1 p2 p2)
				(setq LastObj (vlax-ename->vla-object (entlast)))
				(write-line (strcat "," (rtos(vla-get-Measurement LastObj) 2 4)) pw)
			)
			(close pw)
		)
		(princ "*** Chon lung tung roi! Lam lai nhe! ***")
	)
	(mapcar 'setvar lst_va old)
	(princ)
)

 

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
18 giờ trước, gia_bach cho biết:

Có thể thay đoạn: ...get-measurement ... bằng (Distance p1 p2)

Làm thế nó nhanh & gọn hơn nhưng không sát với y/c của thớt mà bác!

(Nếu Dímtyle hiện hành có Scale Factor <>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

Bạn thử xem ^^

(defun c:HH(/ lst_va old mcat tenMC plDo plXanh lst_ver fn pw p2 i LastObj lst_data)
	(setq lst_va '("osmode" "cmdecho"))
	(setq old (mapcar 'getvar lst_va))
	(mapcar 'setvar lst_va '(0 0))
	(vl-load-com)
	;-----------------------
(prompt "\n Chon ten mat cat!")
(setq mcat (ssget "+.:E:S" (list (cons 0 "TEXT,MTEXT"))))
(while mcat 
	(setq tenMC (cdr (assoc 1 (entget (ssname mcat 0)))))
	(setq plDo (car(entsel "\n Chon duong mau do: ")))
	(setq plXanh (car(entsel "\n Chon duong mau xanh: ")))
	(if (and tenMC plDo plXanh)
		(progn
			(setq lst_ver (acet-geom-vertex-list plDo))
			(if (< (car (last lst_ver)) (car (car lst_ver))) (setq lst_ver (reverse lst_ver)) )
			(setq i 1)
			(foreach p1 lst_ver
				(setq p2 (vlax-curve-getClosestPointTo plXanh p1))
				(MakeText p1 (itoa i) 0.12 0 "L" nil "stt" nil nil)
				(command ".dimaligned" p1 p2 p2)
				(setq LastObj (vlax-ename->vla-object (entlast)))
				(setq lst_data (cons (strcat tenMC "," (itoa i) "," (rtos(vla-get-Measurement LastObj) 2 4) "," (rtos (car p1) 2 4) "," (rtos (cadr p1) 2 4) "," (rtos (last p1) 2 4)) lst_data))
				(setq i (1+ i))
			)
		)
		(princ "*** Chon lung tung roi! Lam lai nhe! ***")
	)	;if
	(prompt "\n Chon ten mat cat! <Enter de xuat so lieu>")
	(setq mcat (ssget "+.:E:S" (list (cons 0 "TEXT,MTEXT"))))
)	;while
(if lst_data
	(progn
		(setq lst_data (reverse lst_data))
		(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 		(setq pw (open fn "w"))
		(write-line (strcat "Mat cat, STT, K/cach, X, Y, Z") pw)
		(foreach elem lst_data
			(write-line elem pw)
		)
		(close pw)
	)
)
	(mapcar 'setvar lst_va old)
	(princ)
)
;;==================================================
(defun MakeText (point string Height Ang justify Style Layer Color xdata / Lst)
; Ang: Radial	
(setq Lst (list '(0 . "TEXT")
				(cons 8 (if Layer Layer (getvar "Clayer")))									
				(cons 62 (if Color Color 256))									
				(cons 10 point)									
				(cons 40 Height)									
				(cons 1 string)									
				(if Ang (cons 50 Ang))									
				(cons 7 (if Style Style (getvar "Textstyle")))									
				(cons -3 (if xdata (list xdata) nil)))				
				justify (strcase justify))	
				(cond ((= justify "C") (setq Lst (append Lst (list (cons 72 1) (cons 11 point)))))				
					  ((= justify "R") (setq Lst (append Lst (list (cons 72 2) (cons 11 point)))))				
					  ((= justify "M") (setq Lst (append Lst (list (cons 72 4) (cons 11 point)))))				
					  ((= justify "TL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 3)))))				
					  ((= justify "TR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 3)))))					
					  ((= justify "ML") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 2)))))				
					  ((= justify "MR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 2)))))				
					  ((= justify "BL") (setq Lst (append Lst (list (cons 72 0) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BC") (setq Lst (append Lst (list (cons 72 1) (cons 11 point) (cons 73 1)))))				
					  ((= justify "BR") (setq Lst (append Lst (list (cons 72 2) (cons 11 point) (cons 73 1)))))
					  )	
					  (entmakex Lst)
)	;end

 

  • 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
20 phút trước, timmaimotnguoi cho biết:

Lisp của bác rất ok. đúng như tớ mọng đợi: nhưng nếu bác cho e thêm một cột ở bang excel thông số area như vậy là ngon ạ ( area này là của đường pline màu đỏ ạ)

 


Nghe bạn mấy lần "Thêm một cột ..." là ngon vài lần mà cũng thấy buồn :))

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác
1 phút trước, timmaimotnguoi cho biết:

Thực ra lúc nhờ viết lại không nghĩ đến cái cột đó. Khi xong rồi mới nhớ. chứ đâu ai muốn đi nhờ rồi còn kì kèo họ. 

 

Vì thế khi yêu cầu hỗ trợ, các bạn nên nghĩ kỹ trước rồi viết :) Lisp người ta viết mới lâu chứ các bạn nghĩ thêm 5p để yêu cầu một cách kín kẽ sẽ k đáng là bao đâu. 
Chúng tôi quá mệt mỏi với các lý do "Lúc nhờ thì quên rồi" . Đương nhiên bài này tôi k code nên cá nhân tôi k phiền lòng gì cả, chỉ than phiền hộ các bạn viết code thôi

@hiepttr : bác lười quá nên cứ để hàm make_text dài thoòng kia, chứ đáng ra nó cũng chỉ chục dòng thôi chứ ^^ 
Hơn nữa bác cũng nên chú ý người dùng là máy phải cài Express, phòng khi họ không sử dụng được lại mắng vốn mình

P/s : @timmaimotnguoi : đại từ nhân xưng có thể là TÔI, nhưng đừng bỏ đi bạn ạ
Have fun

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
Vào lúc 1/11/2017 tại 13:07, hiepttr đã nói:

Quick code cho bạn


;lisp viet theo y/c: http://www.cadviet.com/forum/topic/170671-nh%E1%BB%9D-vi%E1%BA%BFt-lisp-t%E1%BA%A1o-dim-vu%C3%B4ng-g%C3%B3c-gi%E1%BB%AFa-hai-%C4%91%C6%B0%E1%BB%9Dng-polyline/
(defun c:DDD(/ lst_va old plDo plXanh lst_ver fn pw p2 LastObj)
	(setq lst_va '("osmode" "cmdecho"))
	(setq old (mapcar 'getvar lst_va))
	(mapcar 'setvar lst_va '(0 0))
	(setq plDo (car(entsel "\nChon duong mau do: ")))
	(setq plXanh (car(entsel "\nChon duong mau xanh: ")))
	(if (and plDo plXanh)
		(progn
			(setq lst_ver (acet-geom-vertex-list plDo)
				  )
			(if (< (car (last lst_ver)) (car (car lst_ver))) 
				(setq lst_ver (reverse lst_ver))
			)
			(setq fn (getfiled "Chon file de xuat ket qua" "" "csv" 1))
 			(setq pw (open fn "w"))
			(write-line (strcat "STT, K/cach") pw)	
			(foreach p1 lst_ver
				(setq p2 (vlax-curve-getClosestPointTo plXanh p1))
				(command ".dimaligned" p1 p2 p2)
				(setq LastObj (vlax-ename->vla-object (entlast)))
				(write-line (strcat "," (rtos(vla-get-Measurement LastObj) 2 4)) pw)
			)
			(close pw)
		)
		(princ "*** Chon lung tung roi! Lam lai nhe! ***")
	)
	(mapcar 'setvar lst_va old)
	(princ)
)

 

Chân thành cảm ơn bạn. Đúng như minh yêu cầ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

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

×