Vẽ Polyline Bám Theo Các Polyline Trước(Ý Tưởng Trải Vải Địa)

[ThanhDattdk 3]

em xin chào mọi người.làm thế nào mình có thể xác định các đỉnh pl để vẽ pl bám theo được.nếu làm bằng thủ công thi lâu quá.xin các bác giúp đỡ.

[hiepttr 538]

- Nếu bạn cần ý tưởng: Trong lisp có thể dùng  (acet-geom-vertex-list en) để lấy đỉnh của PL (là một cách).

- Nếu bạn cần code: Phiền bạn up thêm file CAD có vài trắc ngang như trên

P/s: Cái hình nhìn đau mắt quá :D

[ThanhDattdk 3]

- Nếu bạn cần ý tưởng: Trong lisp có thể dùng  (acet-geom-vertex-list en) để lấy đỉnh của PL (là một cách).

- Nếu bạn cần code: Phiền bạn up thêm file CAD có vài trắc ngang như trên

P/s: Cái hình nhìn đau mắt quá :D

em gửi bác xem hộ vài trắc ngang, mong bác chỉ giáo ạ

http://www.cadviet.com/upfiles/6/154132_drawing1.dwg

[quocmanh04tt 635]

Về thuật toán, với loại trắc ngang này chỉ cần 1 lần quét chọn có thể thực hiện được cho tất cả.

[hiepttr 538]

Mấy hôm nay bận nên Rep bạn hơi muộn ^^

Chúc công việc suôn sẻ !

;lisp trai vai dia
;=================================
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)	
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  
				(cons 6 (if Linetype Linetype "bylayer"))									
				(cons 48 (if LTScale LTScale 1))									
				(cons 62 (if Color Color 256))									
				'(100 . "AcDbPolyline")									
				(cons 90 (length listpoint))									
				(cons 70 (if closed 1 0))))	
(foreach PP listpoint	
	(setq Lst (append Lst (list (cons 10 PP))))
	)	
				(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))	
				(entmakex Lst)
)	;end
;===================================
(defun get_lst_vertex (PL / lst)
	(setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget PL))))
	(if (< (car (car lst)) (car (last lst))) lst (reverse lst))
)
;=============================================================================================
(defun c:TRAI ( / cmd ss_coc ins_point ss lst_ver len i)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(prompt "\nQuet chon trac ngang: ")
(setq ss_coc (ssget '((0 . "TEXT") (8 . "entdauco") (1 . "C*c:*"))))
(if ss_coc 
	(progn
		(setq ss_coc (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss_coc))))
		(foreach coc ss_coc
			(setq ins_point (cdr (assoc 11 (entget coc)))
				  ss (ssget "_W" (list (- (car ins_point) 17) (- (cadr ins_point) 15)) (list (+ (car ins_point) 17) (cadr ins_point))
						(list (cons 8 "VetHuuCo,Danh cap"))))
			(if ss
				(progn
					(setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
						  ss (vl-sort ss '(lambda (x y)  (< (car (car (get_lst_vertex x))) (car (car (get_lst_vertex y))))))
					)
					(setq lst_ver (get_lst_vertex (car ss)))
					(cond 
						((> (setq len (length ss)) 1)
							(setq i 0)
							(repeat (- len 1)
								(setq lst_ver (reverse (cdr (reverse lst_ver)))
									lst_ver (append lst_ver (cdr (get_lst_vertex (nth (setq i (1+ i)) ss))))
								)
							)
						)
					)
					(setq lst_ver 
						(append 
							(list (list (1+ (car (car lst_ver))) (cadr (car lst_ver))))
							lst_ver 
							(list (list (1- (car (last lst_ver))) (cadr (last lst_ver))))
						))
					(MakeLWPolyline lst_ver nil nil nil "Vai_dia_KT" 4 nil)
				)
			)
		)
	)
)
(setvar 'cmdecho cmd)
(princ)
)

[NguyenBan Cad3D 2]

cũng đang lay hoay, theo cái mới chưa quen, hơi khó.

[ThanhDattdk 3]

 

Mấy hôm nay bận nên Rep bạn hơi muộn ^^

Chúc công việc suôn sẻ !

;lisp trai vai dia
;=================================
(defun MakeLWPolyline (listpoint closed Linetype LTScale Layer Color xdata / Lst)	
(setq Lst (list '(0 . "LWPOLYLINE")'(100 . "AcDbEntity")									
				(cons 8 (if Layer Layer (getvar "Clayer")))								  
				(cons 6 (if Linetype Linetype "bylayer"))									
				(cons 48 (if LTScale LTScale 1))									
				(cons 62 (if Color Color 256))									
				'(100 . "AcDbPolyline")									
				(cons 90 (length listpoint))									
				(cons 70 (if closed 1 0))))	
(foreach PP listpoint	
	(setq Lst (append Lst (list (cons 10 PP))))
	)	
				(if xdata (setq Lst (append lst (list (cons -3 (list xdata))))))	
				(entmakex Lst)
)	;end
;===================================
(defun get_lst_vertex (PL / lst)
	(setq lst (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= 10 (car x))) (entget PL))))
	(if (< (car (car lst)) (car (last lst))) lst (reverse lst))
)
;=============================================================================================
(defun c:TRAI ( / cmd ss_coc ins_point ss lst_ver len i)
(setq cmd (getvar 'cmdecho))
(setvar 'cmdecho 0)
(prompt "\nQuet chon trac ngang: ")
(setq ss_coc (ssget '((0 . "TEXT") (8 . "entdauco") (1 . "C*c:*"))))
(if ss_coc 
	(progn
		(setq ss_coc (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss_coc))))
		(foreach coc ss_coc
			(setq ins_point (cdr (assoc 11 (entget coc)))
				  ss (ssget "_W" (list (- (car ins_point) 17) (- (cadr ins_point) 15)) (list (+ (car ins_point) 17) (cadr ins_point))
						(list (cons 8 "VetHuuCo,Danh cap"))))
			(if ss
				(progn
					(setq ss (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
						  ss (vl-sort ss '(lambda (x y)  (< (car (car (get_lst_vertex x))) (car (car (get_lst_vertex y))))))
					)
					(setq lst_ver (get_lst_vertex (car ss)))
					(cond 
						((> (setq len (length ss)) 1)
							(setq i 0)
							(repeat (- len 1)
								(setq lst_ver (reverse (cdr (reverse lst_ver)))
									lst_ver (append lst_ver (cdr (get_lst_vertex (nth (setq i (1+ i)) ss))))
								)
							)
						)
					)
					(setq lst_ver 
						(append 
							(list (list (1+ (car (car lst_ver))) (cadr (car lst_ver))))
							lst_ver 
							(list (list (1- (car (last lst_ver))) (cadr (last lst_ver))))
						))
					(MakeLWPolyline lst_ver nil nil nil "Vai_dia_KT" 4 nil)
				)
			)
		)
	)
)
(setvar 'cmdecho cmd)
(princ)
)

em cảm ơn bác.rút ngắn thời gian rất nhiều, em chỉ mới tập tành chưa hiểu nhiều, bác có thể cho em biết sơ về thuật toán ko ạ.chúc bác sức khỏe