Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
google123

Lisp vẽ line từ điểm đến đối tượng cho trước

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

Dear các anh, em có bài toán như sau mong các anh giúp em muốn vẽ line từ điểm đến đôi tượng cho trước đê nhằm xác định hướng của lô thửa như hình sau, line lisp tự động vẽ là line màu vàng ...

đối tượng xuất phát từ điểm của text và kết thúc tại line màu xanh ( đường vàng có thể song song , vuông góc với line trắng sao cho kết thúc tại line xanh lá là được )

em xin gửi file cad ạ.

mục đính của em là tính được hướng của từng lô thửa đất ...

đây là file cad 

 

 

image.thumb.png.946ca4e4fd709c5b5773a5202f065872.png

 

question.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

- lâu rùi có mót đc anh nào cái hàm phù hợp mong mún của bạn, bạn test thử, line vẽ theo layer hiện hành nha ^^, cuối giờ làm biếng hihi

(defun c:KKK(/ ent ss ds_ip ds_text )
(setq ent (car (entsel "\nChon pline cho truoc: ")))
(alert "chon text")
(setq ss (ssget '((0 . "*text"))))
(if (and ss ent)
	(progn
		(setq ds_text (ss2ent ss))
		(setq ds_ip (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ds_text))
		(foreach k ds_ip (lpp2c k ent))
	)
)
(princ)
)	

(defun LPP2C (p1 c / p2);;;Line from Point p1 Perpendicular To Curve c
(vl-load-com)
(setq p2 (vlax-curve-getClosestPointTo c p1 T))
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)
;==================
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;===================

 

  • 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
Vào lúc 12/7/2019 tại 16:50, nhoclangbat đã nói:

- lâu rùi có mót đc anh nào cái hàm phù hợp mong mún của bạn, bạn test thử, line vẽ theo layer hiện hành nha ^^, cuối giờ làm biếng hihi


(defun c:KKK(/ ent ss ds_ip ds_text )
(setq ent (car (entsel "\nChon pline cho truoc: ")))
(alert "chon text")
(setq ss (ssget '((0 . "*text"))))
(if (and ss ent)
	(progn
		(setq ds_text (ss2ent ss))
		(setq ds_ip (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ds_text))
		(foreach k ds_ip (lpp2c k ent))
	)
)
(princ)
)	

(defun LPP2C (p1 c / p2);;;Line from Point p1 Perpendicular To Curve c
(vl-load-com)
(setq p2 (vlax-curve-getClosestPointTo c p1 T))
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))
)
;==================
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;===================

 

mình cảm ơn bạn nha, lisp chạy rất tốt nhưng mà nó chưa được như ý muốn của mình lắm:

-Kết quả đường line mình mong muốn là nó sẽ vuông góc hoặc song song với cái cạnh thửa đất, chứ không vuông góc với cái line đường

-có thể sửa lại giúp mình chọn point thay vì text được không ^^!

hy vọng bạn có thể sửa giúp mình, mình cảm ơn bjan nhiều lắm....

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

- vuông góc thì được, song song mình chưa nghĩ ra ^^

(defun c:KKK(/ ent ss ds_ip ds_text ss2 ds_li ss3 en)
(setvar 'osmode 0)
(setvar 'cmdecho 0)
(setq ent (car (entsel "\nChon pline cho truoc: ")))
(alert "chon point")
(setq ss (ssget '((0 . "POINT"))))
(if (and ss ent)
	(progn
		(setq ds_text (ss2ent ss))
		(setq ds_ip (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ds_text))
		(foreach k ds_ip (lpp2c k ent "duong_giong"))
		;-----------------------------------------------------
		(setq ss2 (ssget "X" '((8 . "duong_giong"))))
		(if ss2 
			(progn
				(setq ds_li (ss2ent ss2))
				(foreach k ds_li
					(setq dx10 (cdr (assoc 10 (entget k))) dx11 (cdr (assoc 11 (entget k))))
					(setq ss3 (ssget "F" (list dx10 dx11) '((8 . "Level 10"))))
					(setq en (ssname ss3 0))
					(lpp2c dx10 en "chi_giong")
					(vl-cmdf ".extend" ent "" (entlast) "")
					(vl-cmdf ".erase" k "")
				)
				(vl-cmdf "-purge" "layer" "duong_giong" "n")
			)
		);end if ss2		
	)
)
(setvar 'cmdecho 1)
(princ)
)	

(defun LPP2C (p1 c lay / p2);;;Line from Point p1 Perpendicular To Curve c
(vl-load-com)
(setq p2 (vlax-curve-getClosestPointTo c p1 T))
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 (if lay lay)) ))
)
;==================
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;===================

 

  • 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
1 giờ} trướ}c, nhoclangbat đã nói:

- vuông góc thì được, song song mình chưa nghĩ ra ^^


(defun c:KKK(/ ent ss ds_ip ds_text ss2 ds_li ss3 en)
(setvar 'osmode 0)
(setvar 'cmdecho 0)
(setq ent (car (entsel "\nChon pline cho truoc: ")))
(alert "chon point")
(setq ss (ssget '((0 . "POINT"))))
(if (and ss ent)
	(progn
		(setq ds_text (ss2ent ss))
		(setq ds_ip (mapcar '(lambda (x) (cdr (assoc 10 (entget x)))) ds_text))
		(foreach k ds_ip (lpp2c k ent "duong_giong"))
;-----------------------------------------------------
		(setq ss2 (ssget "X" '((8 . "duong_giong"))))
		(if ss2 
			(progn
				(setq ds_li (ss2ent ss2))
				(foreach k ds_li
					(setq dx10 (cdr (assoc 10 (entget k))) dx11 (cdr (assoc 11 (entget k))))
					(setq ss3 (ssget "F" (list dx10 dx11) '((8 . "Level 10"))))
					(setq en (ssname ss3 0))
					(lpp2c dx10 en "chi_giong")
					(vl-cmdf ".extend" ent "" (entlast) "")
					(vl-cmdf ".erase" k "")
				)
				(vl-cmdf "-purge" "layer" "duong_giong" "n")
			)
		);end if ss2		
	)
)
(setvar 'cmdecho 1)
(princ)
)	

(defun LPP2C (p1 c lay / p2);;;Line from Point p1 Perpendicular To Curve c
(vl-load-com)
(setq p2 (vlax-curve-getClosestPointTo c p1 T))
(entmake (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2) (cons 8 (if lay lay)) ))
)
;==================
(defun ss2ent (ss / i Le e);;;Convert ss to list of ename
(setq i 0)
(repeat (sslength ss)
(setq e (ssname ss i)
Le (append Le (list e))
i (1+ i)    ))
Le)
;===================

 

dạ em cần một trong hai thôi anh, vuông góc là được rồi ạ, em còn một vấn đề nữa là anh có thể giúp em chỉnh cho lisp có thể chọn đc nhiều line không ạ, vì bản vẽ của em rất nhiều line nên chọn để vẽ rất tốn công, mong anh lỡ giúp em rồi giúp cho trót ạ..

  • 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

Cái này vẽ song song:

 - chọn 1 pline cho truoc (pline mau xanh)

- Chọn các các text, mtext, block hoặc point cần vẽ

- chọn các LINE là canh của khu đất để định hướng vẽ song song

(defun c:lss (/ ent ss spar p1 lsdis enpar ang l1 pt)
  (setq ent (car (entsel "\nChon pline cho truoc: ")))
  (princ"\nChon cac TEXT, MTEXT, BLOCK, POINT")
  (setq ss (ssget '((0 . "*text,insert,point"))))
  (princ"\nChon cac LINE canh khu dat de ve song song")
  (setq spar (ssget '((0 . "line"))))
  (if (and ss ent spar)
    (progn
      (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq spar (vl-remove-if 'listp (mapcar 'cadr (ssnamex spar))))
      (foreach k ss
	(setq p1 (dxf 10 k))
	(setq lsdis (vl-sort spar '(lambda (x y) (< (dis p1 x) (dis p1 y)))))
	(setq enpar (car lsdis))
	(setq ang (angle (dxf 10 enpar) (dxf 11 enpar)))
	(setq l1 (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 (polar p1 5 ang))(cons 62 2)))))
	(setq pt (vlax-invoke l1 'IntersectWith (vlax-ename->vla-object ent) acExtendBoth))
	(vla-put-EndPoint l1 (vlax-3d-point pt))
	)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
(defun dis (p en)
  (distance p (vlax-curve-getClosestPointTo en p T))
  )
(defun DXF (code ent) (cdr (assoc code (entget ent))))

 

  • 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
16 phút trước, tien2005 đã nói:

Cái này vẽ song song:

 - chọn 1 pline cho truoc (pline mau xanh)

- Chọn các các text, mtext, block hoặc point cần vẽ

- chọn các LINE là canh của khu đất để định hướng vẽ song song


(defun c:lss (/ ent ss spar p1 lsdis enpar ang l1 pt)
  (setq ent (car (entsel "\nChon pline cho truoc: ")))
  ("\nChon cac TEXT, MTEXT, BLOCK, POINT")
  (setq ss (ssget '((0 . "*text,insert,point"))))
  ("\nChon cac LINE canh khu dat de ve song song")
  (setq spar (ssget '((0 . "line"))))
  (if (and ss ent spar)
    (progn
      (setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
      (setq spar (vl-remove-if 'listp (mapcar 'cadr (ssnamex spar))))
      (foreach k ss
	(setq p1 (dxf 10 k))
	(setq lsdis (vl-sort spar '(lambda (x y) (< (dis p1 x) (dis p1 y)))))
	(setq enpar (car lsdis))
	(setq ang (angle (dxf 10 enpar) (dxf 11 enpar)))
	(setq l1 (vlax-ename->vla-object (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 (polar p1 5 ang))(cons 62 2)))))
	(setq pt (vlax-invoke l1 'IntersectWith (vlax-ename->vla-object ent) acExtendBoth))
	(vla-put-EndPoint l1 (vlax-3d-point pt))
	)
    ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun
(defun dis (p en)
  (distance p (vlax-curve-getClosestPointTo en p T))
  )
(defun DXF (code ent) (cdr (assoc code (entget ent))))

 

cái này có thể có phép chọn một lúc nhiều line cho trước không anh

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ái này chỉ chọn 1 pline màu xanh thôi, chọn nhiều pline thì code xử lý phức tạp hơn nhiều

Lưu ý: pline màu xanh không nên có dạng vẽ vòng lại như chữ U, khi đó code bị lỗi.

  • 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

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
Đăng nhập để thực hiện theo  

×