Kéo điểm đoạn thẳng đến vị trí mới

[VoHoan 6]

Trên bản vẽ mình có 1 đoạn thẳng AB, giờ mình muốn kéo điểm B về điểm C (khác điểm A và B, đối tượng là đoạn thẳng AB không được xóa đế tạo đoạn AB mới) thì viết đoạn mã lisp này như thế nào, nhờ ai biết chỉ giùm với. Mình đang vướng đoạn này cho cái lisp mà đang nhờ mọi người ở bài "[Yêu cầu] Viết lisp điều chỉnh trắc ngang đường"

 

 

[quansla 259]

Bạn biết lisp bạn biết thuật toán thì mình sẽ nói sơ sơ thế này nhé

• "kéo" B về điểm C, có thể sử dụng lệnh (getpoint pB "\nChon diem C can keo den")    trong đó pB là tọa độ điểm B mà bạn cần "kéo" khi đó hàm (getpoint..) sẽ tạo ra một "dây thun" có gốc là tọa độ điểm B trên màn hình Cad, ngọn là vị trí mà chuột của bạn đang đứng, khi bạn nhấp trái chuột, hàm (getpoint ...) kết thúc trả về một tọa độ (chính là tọa độ điểm mà chuột trái nhấp vô (chú ý phải có tọa độ pB trước nhé, để làm được thì có nhiều cách lắm)
• Như vậy nếu bạn sử dụng hàm (getpoint..) ở trên kết hợp với setq chẳng hạn (setq pC (getpoint pB "\nChon diem C can keo den")) thì bạn sẽ có một biến pC mang tọa độ điểm C, nếu cũng có thể (setq pA ....) bằng một phương pháp nào đó thì ở đây bạn có được bộ 2 biến (pA, pC) là các tọa độ của một đoạn thẳng cần tạo mới.
• Tiếp đây công việc hết sứcđơn giản . Dùng hàm (command "_line" pA pC "") là xong (nếu biết về entmake thì còn tuyệt hơn.

Chúc bạn thành  công

P/S hết sức chú ý phần làm sao để lấy được pA,pB là điểm nào trong số 2 điểm của Line đã chọn ban đầu (vì có 2 trường hợp xảy ra cặp (pA,pB) thứ tự là (điểm đầu, điểm cuối) và cũng có thể là theo thứ tự (điểm cuối, điểm đầu))

(progn

  (if(setq ss (ssget '((0 . "LINE"))))

    (progn

      (setq dt (entget(ssname ss 0))

   pA (cdr(assoc 10 dt))

   pB (cdr(assoc 11 dt)))

      (setq pC (getpoint pB "\nChon diem C can keo den"))

      (entmakex

(list

 '( 0 . "Line")

 '(62 . 1)

 (cons 10 pA)

 (cons 11 pC)))

      )

    (princ "\nKhong lam gi ca"))

  (princ))

[VoHoan 6]

Cảm ơm quansla đã có ý kiến giúp mình. Nhưng bạn chưa hiểu rõ ý mình muốn diễn đạt. Ở đây mình muốn kéo điểm B về điểm C (trong đó AB đã có, điểm C đã xác định được) mà vẫn giữ nguyên đối tượng là đoạn thẳng AB, chứ không phải tạo ra AB bằng lệnh "LINE" nữa. Mục đích vì AB là đối tượng của phần mềm TK đường VNROAD nên không làm thay đổi ENTNAME của nó để sau VNR vẫn nhận ra mà không bị lỗi.

Cái mình vướng ở đây là thao tác "KÉO" điểm B về điểm C. Thao tác trên Cad là chọn đoạn thẳng AB sau đó pick vào điểm B kéo nó về C. Việc này viết trên lisp mình không thực hiện được.

Mình có 2 giải pháp nhưng không khả thi lắm như sau:

1. Dùng lệnh "STRETCH" để kéo, nhưng nhựơc điểm là nếu trên bản vẽ chỉ có đoạn AB thì dễ làm được, còn có nhiều đối tượng nằm gần AB thì không được vì ảnh hướng đến nhiều đối tượng khác.

2. Dùng hàm "ENTMOD" để thay đổi mã DXF của giá trị (10 X Y) của (ENTGET AB) thì làm được với điều kiện AB chỉ có >=2 đỉnh thì được. Nếu nhiều hơn 2 đỉnh thì trong (ENTGET AB) có nhiều giá trị (10 X Y) khó tìm để thay đổi được.

MÌnh đã viết được lisp sửa trắc ngang dùng theo cách thứ 2 nhưng chưa ưng ý. Ai có cách gì hay hơn chỉ ra giúp mình nhé:

(defun C:keo ( / SS P P2 P3 PTL Pmep TR1 TR2 PH1 PH2 SSM SSL SSTL SSTN SSR S1 S2 S3 S4 S5
                 i KT SR ent layer P10 XP10 YP10 K11 P11 ob1 ob2 kq g)
(setvar "CMDECHO" 0)
(setvar "osmode" 0) 
(princ "\nChon trac ngang")
(setq	SS (ssget '((0 . "LWPOLYLINE") (8 . "Lop2")) ))
(setq	S (ssname SS 0)
	P2 (vlax-curve-getPointAtParam S 1)
	P3 (vlax-curve-getPointAtParam S 3)
)
(setq	TR1 (polar P2 (/ pi 4) 3.5)
	TR2 (polar P2 (/ pi 4) -3.5)
	PH1 (polar P3 (/ pi 4) 3.5)
	PH2 (polar P3 (/ pi 4) -3.5)
)
(matduong TR1 TR2 P2)
(matduong PH1 PH2 P3)
)


;**************Xu ly tung mat duong*********************
(defun Matduong (W1 W2 Mep)
(setq	SSM (ssget "C" W1 W2 '( (8 . "Mat duong 1")) )
	SSL (ssget "C" W1 W2 '( (8 . "Le KGC")) )
	SSTL (ssget "C" W1 W2 '( (8 . "Taluy")) )
	SSTN (ssget "C" W1 W2 '( (8 . "plinetntn")) )
	SSR (ssget "C" W1 W2)
)
(setq	S1 (ssname SSM 0)
	P (vlax-curve-getPointAtParam S1 1)
)
(setq	S2 (ssname SSL 0)
	S3 (ssname SSTL 0)
	S4 (ssname SSTN 0)
	i 0
	Kt 0
)
(repeat (sslength SSR)
  (setq	SR (ssname SSR i)
	ent (assoc 8 (entget SR))
	layer (cdr ent)
	i (+ i 1)
  )
  (if	(= layer "Ranh") 
	(progn
		(setq KT 1)
		(Setq S5 SR)
	)
  )
)

(if (= Kt 1) (command "MOVE" S2 S3 S5 "" P Mep) (command "MOVE" S2 S3 "" P Mep))

;Xu ly list duong mat duong
(Keodiem S1 Mep)

;Xu ly list duong taluy
(setq PTL (car (GiaoDT S3 S4)))
(keodiem S3 PTL)

)

;********************Keo diem doan thang**********************
(defun Keodiem (SDT PDT)
(setq	ent (entget SDT)
	P10 (assoc 10 ent)
	XP10 (cadr P10)
	YP10 (caddr P10)
	K11 (list 11 XP10 YP10)
	P11 (list 10 XP10 YP10)
	ent (subst K11 P10 ent)

)
(setq	P10 (assoc 10 ent)
	XP10 (car PDT)
	YP10 (cadr PDT)
	K10 (list 10 XP10 YP10)
	ent (subst K10 P10 ent)
	K11 (assoc 11 ent)
	ent (subst P11 K11 ent)
)
(entmod ent)
)

;********************Tim giao diem*******************
(defun GiaoDT (ent1 ent2)
(setq	ob1 (vlax-ename->vla-object ent1)
	ob2 (vlax-ename->vla-object ent2)
)
(setq	g (vlax-variant-value (vla-IntersectWith ob1 ob2 acExtendNone)) )
(if	(/= (vlax-safearray-get-u-bound g 1) -1)
	(setq g (vlax-safearray->list g))
	(setq g nil)
)
(if	g
	(progn
		(setq	kq nil 
			sd (fix (/ (length g) 3))
		)
		(repeat sd
			(setq	kq (append kq (list (list (car g) (cadr g) (caddr g))))
				g (cdddr g)
			)
		)
		kq
	)
		nil
)
)

[Tue_NV 3.912]

Cảm ơm quansla đã có ý kiến giúp mình. Nhưng bạn chưa hiểu rõ ý mình muốn diễn đạt. Ở đây mình muốn kéo điểm B về điểm C (trong đó AB đã có, điểm C đã xác định được) mà vẫn giữ nguyên đối tượng là đoạn thẳng AB, chứ không phải tạo ra AB bằng lệnh "LINE" nữa. Mục đích vì AB là đối tượng của phần mềm TK đường VNROAD nên không làm thay đổi ENTNAME của nó để sau VNR vẫn nhận ra mà không bị lỗi.

Cái mình vướng ở đây là thao tác "KÉO" điểm B về điểm C. Thao tác trên Cad là chọn đoạn thẳng AB sau đó pick vào điểm B kéo nó về C. Việc này viết trên lisp mình không thực hiện được.

Mình có 2 giải pháp nhưng không khả thi lắm như sau:

1. Dùng lệnh "STRETCH" để kéo, nhưng nhựơc điểm là nếu trên bản vẽ chỉ có đoạn AB thì dễ làm được, còn có nhiều đối tượng nằm gần AB thì không được vì ảnh hướng đến nhiều đối tượng khác.

2. Dùng hàm "ENTMOD" để thay đổi mã DXF của giá trị (10 X Y) của (ENTGET AB) thì làm được với điều kiện AB chỉ có >=2 đỉnh thì được. Nếu nhiều hơn 2 đỉnh thì trong (ENTGET AB) có nhiều giá trị (10 X Y) khó tìm để thay đổi được.

MÌnh đã viết được lisp sửa trắc ngang dùng theo cách thứ 2 nhưng chưa ưng ý. Ai có cách gì hay hơn chỉ ra giúp mình nhé:

 

Chào bạn VoHoan!

Mình thấy dùng lệnh "Stretch" ok. TH không được, bạn cho 1 ví dụ bằng 1 file dwg đơn giản nhé!

[ndtnv 481]

Vì bạn đã khá về lisp nên tôi chỉ nói về thuật toán Keodiem

Giao tham số cho hàm kéo điểm là sdt, vector dịch chuyển (dx, dy), 2 điểm W1, W2

Dùng hàm sau để lấy danh sách đỉnh của Pline

(setq L10 (vl-remove-if '(lambda (x) (/= 10 (car x))) ent))

Dùng foreach lấy các điểm trong L10

Nếu điểm này nằm trong cửa sổ W1,W2 thì dùng subst để cộng điểm này với vector dịch chuyển

Sau cùng là (entmod ent)

[VoHoan 6]

Cảm ơn Tue_NV và ndtnv đã góp ý kiến. Cách dùng "STRETCH" thì mình thấy không hiệu quả với nó chỉ giải quyết những trường hợp riêng thôi. Cách của ndtnv thì mình sẽ thử xem ntn, cách này chắc là trường hợp tổng quát của cách mình đang áp dụng.