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

garupro

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    34

  • Đã tham gia

  • Lần ghé thăm cuối

Bài đăng được đăng bởi garupro

  1. Đã đăng · Trả lời báo cáo

    Cái này có thuật toán gì đâu, chỉ là biến đổi toán học dựa vào hình học thôi mà. Tôi chứng minh cho phía bên trái nhé!

    67029_chia_dien_tich_2.png

    Cảm ơn bác Hà . Thuật toán hay quá, không phải dịch chuyển để dò vị trí nữa. Nhưng mình có một thắc mắc là cái CD thì biết, vậy S1, S2, S3, S4 thì xác định kiểu gì khi mà chưa có EC

  2. Đã đăng · Trả lời báo cáo

    Sao bác Garupro không có ý kiến gì hết vậy?!!

     

     

     

     

    Bác lyky đã đề nghị bạn giải quyết lần lượt cho từng nhánh, bác đã trả lời là: "Cách này thì trước đây mình có hỏi và hiện tại đã giải quyết được" giờ lại hỏi lại?

     

    Xin lỗi, mấy nay bận quá không có thời gian vô TP được.

     

    Cái này không phải mình hỏi lại lần hai. Thực ra mình đang làm phần mềm liên quan đến phần điều phối đất. Đến phân chia mảnh thì mình bí quá .Theo bác lyky thì chỉ dịch chuyển cái đường thẳng đứng để W1=W2 còn đường điều phối, và đoạn MN ko cố định nữa thì trước đây mình có hỏi trên CV rùi.

    Bạn Song Nhi để ý cách của bạn lyky  và TP mình đưa ra hoàn toàn khác nhau mà.

  3. Đã đăng · Trả lời báo cáo

    Cảm ơn các bạn đã quan tâm và giúp đỡ, nhưng xem chừng yêu cầu của mình hơi cao. Vì vậy mình xin đưa bài toán của mình về đơn giản nhất mong các bạn viết giúp mình để giải quyết nó với (thực ra mình đã làm được với Net nhưng tốc độ chậm quá) nên nhờ các bạn viết dùm mình cái lisp vậy

    3566.png

     

    Lisp này mình sử dụng kết hợp với Net  nền việc chọn đối tượng nếu có thể thì chọn theo cách nhập Handle của đối tượng đó

    Yêu cầu như sau :

    Nhập Handle của đường cong tích luỹ

    Nhập Handle của đường điều phối (ĐƯờng này mình tự vạch đấy)

    Nhập Sai số cho phép

     

    Sau đó Lisp sẽ tự làm như sau :Xác định giao điểm của đường điều phối với đường cong tích luỹ phân thành các khối ( ví dụ trong hình là 3 khối)

    Xét từng khối 1, ví dụ với khối 1 ta chia ra làm 2. 1 từ điểm A đến cực trị của đường cong ta vẽ đường Line 1 và dịch sang trái hợc phải khi nào W1 = W2 thì dùng lại, tương tự nửa còn lại ta vẽ Line 2 và dịch nó khi W1 = W2 thì dừng sau khi hết 1 khối thì ghi kích thước và hatch như trong hình sau đó chuyển sang khối khác cho đến hết ( Khi dịch chuyển Line sang trái phải hiện luôn cái W1, W2 trên màn hình sau khi chia xong thì xoá)

    Trên  diễn đàn mình cũng có 1 lisp chia đa giác thành 2 phần bằng nhau rồi, nhưng không ứng dụng vào bài của mình được. Các bạn giúp mình nha. Không biết tý gì về lisp nên đành làm phiền các bạn vậy .

  4. Đã đăng · Trả lời báo cáo

    Cập nhật bản sửa lỗi ở bài viết #18

    - Cho phép xác định độ chính xác diện tích.

    - Giới hạn 100 lần thử để bảo vệ con CPU ko bị bốc khói ^^! Trường hợp này xảy ra khi diện tích tính toán quá lớn trong khi sai số cho phép quá nhỏ!!!

    - Sửa lỗi khi tính toán diện tích, hạn chế và bẫy lỗi do lệnh "-boundary" gây ra. Thg này tính khí cũng hơi thất thường, có lúc cái miền to đùng mà ko lấy boundary được >.<!!

    - Cải thiện tốc độ x2 ^^.

     

    @ bác Hà: đã test bản sửa lỗi trên bản vẽ của bác, chạy hơi lâu một chút do kích thước pline của bác hơi bị bự ^^. Mình đã dùng thử file lisp của bác trên bản vẽ bác cung cấp, nhưng lúc được lúc không. Hay báo lỗi "Hoac sai so qua nho; \nHoac khoang cach MN qua lon, khong hoi tu nen khong giai duoc." mặc dù mình chọn kích thước khá lớn là 300, sai số mặc định. Khi chạy được sai số diện tích cũng khá lớn.

     

    @ garupro: trường hợp "phức tạp" bác đưa ra dường như là một bài toán hoàn toàn khác so với trg hợp "đơn giản" ban đầu. Mình có chút thắc mắc:

    - Đường tích luỹ là pline "gãy" hay "trơn" (có đoạn cong). Nếu là "gãy" thì có thể bàn tiếp, nếu lỡ "trơn" mà các điểm cực trị lọt vào bụng tròn tròn của nó thì pó tay, ko biết sao xác định tất cả các điểm đó. Bác cao thủ nào có ý tưởng về vấn đề này xin góp ý ^^.

    - Theo hình bài số 22, nếu W1 và W2 là từng cặp cân bằng riêng biệt, bài toán le lói hy vọng; còn nếu W1 và W2 là 2 con số cố định cho tất cả các cặp MN thì thiệt tình mình cho là không khả thi với đường PQ cố định, PQ mà di động thì cũng thua vì quá phức tạp. Với trường hợp tổng quát 2*n vùng thì không máy nào chịu nổi, nên có giới hạn số vùng tính toán.

    - Với L và đường PQ cố định, chấp nhận một đoạn MN ko thể cân bằng diện tích vì MN có thể lớn L.

    -Đường tích  lũy là gãy bạn ah, không có đoạn cong , W1,W2 là các cặp khác nhau riêng biệt đối với từng cặp MN, Đường PQ không cố định bạn ah, vẫn có thể di chuyển lên xuống nhưng vẫn đảm bảo số điểm giao với đường tích lũy

  5. Đã đăng · Trả lời báo cáo

    Một bài toán hay, lâu rùi mới có hứng thú lại với Lisp ^^. Đây là giải pháp của mình dựa trên thuật toán của các bác đưa ra, nếu viết có luộm thuộm các bác thông cảm :D . Chưa có thời gian test kỹ, các bác dùng thử nhé ^_^ .

    * Lưu ý kích thước MN quá nhỏ so với PQ có thể gây ra lỗi xác định diện tích, nếu PQ có nhiều điểm cực tiểu, chương trình chỉ tính toán cho điểm điểm cực tiểu thấp nhất.

    (vl-load-com)
(defun c:t1 (/	       AREALST	 ENDPNT	   ENDPNTMN  FROMPNT
	     FUZZ      I0	 I1	   I2	     I3
	     INTPNTS   IX	 IY	   LWP0	     LWP1
	     LWPENT    LWPOBJ	 MN	   MNDIST    MSPACE
	     PNT0      PNT1	 PQ	   S0	     S1
	     S2	       S3	 STARTPNT  STARTPNTMN
	     STARTPNTPQ		 SUB01	   SUB01NEW  SUB32
	     SUB32NEW  THISDRAWING	   TMPLWP    TOPNTX
	     TOPNTY    MAXPOINT	 MINPOINT  ISFLIPED  TMPLWPOBJ
	     BOTPNT    MINMAXPNTS	   TOPPNT
	    )
  ;; Thiet lap
  (setq thisdrawing (vla-get-activedocument (vlax-get-acad-object)))
  (setq mspace (vla-get-modelspace thisdrawing))
  (vla-startundomark thisdrawing)
  (setvar "CMDECHO" 0)
  (if (null MNdistSv)
    (setq MNdistSv 5)
  )
  ;; Du lieu dau vao
  (initget (+ 2 4))
  (setq	MNdist (getreal	(strcat	"\nXac dinh chieu dai MN: <"
				(rtos MNdistSv 2 2)
				">"
			)
	       )
  )
  (if (null MNdist)
    (setq MNdist MNdistSv)
    (setq MNdistSv MNdist)
  )
  (while (null
	   (setq lwpEnt (car (entsel "\nChon duong cong tich luy: ")))
	 )
    (setq lwpEnt (car (entsel "\nChon duong cong tich luy: ")))
  )
  (setq lwpObj (vlax-ename->vla-object lwpEnt))
  (setq	startPnt (vlax-curve-getStartPoint lwpObj)
	endPnt	 (vlax-curve-getEndPoint lwpObj)
  )
  ;; Kiem tra diem cuc tieu
  (setq MinMaxPnts (LM:CurveMinMax lwpObj 1e-8))
  (setq	TopPnt (cadr MinMaxPnts)
	BotPnt (car MinMaxPnts)
  )
  (if (or (equal (distance BotPnt startPnt) 0.0 1e-8)
	  (equal (distance BotPnt endPnt) 0.0 1e-8)
      )
    (progn
      (setq tmpLwpObj (vla-mirror
			lwpObj
			(vlax-3d-point startPnt)
			(vlax-3d-point (polar startPnt 0 0.1))
		      )
		      ;; lat bung
      )
      (vla-delete lwpObj)
      (setq lwpObj   tmpLwpObj
	    isFliped 1
      )
      (setq startPnt (vlax-curve-getStartPoint lwpObj)
	    endPnt   (vlax-curve-getEndPoint lwpObj)
      )
    )
  )
  (vla-GetBoundingBox lwpObj 'minpoint 'maxpoint)
  (vla-ZoomWindow (vlax-get-acad-object) minpoint maxpoint)
  ;; Xac dinh duong PQ
  (if (< (cadr startPnt) (cadr endPnt))
    (setq startPntPQ startPnt)
    (setq startPntPQ endPnt)
  )
  (setq	tmpLwp (AddLwpolyline
		 (list startPntPQ (polar startPntPQ 0 1))
		 0
		 mspace
	       )
  )
  (setq intPnts (LM:Intersections tmpLwp lwpObj acExtendThisEntity))
  (if (> (length intPnts) 1)
    (setq PQ (AddLwpolyline intPnts 0 mspace))
    (progn
      (vla-delete tmpLwp)
      (reset)
      (exit)
    )
  )
  (vla-delete tmpLwp)
  ;; Chieu dai doan MN
  (if (= isFliped 1)
    (setq BotPnt (car (LM:CurveMinMax lwpObj 1e-8)))
  )
  (setq	startPntMN (polar BotPnt pi (/ MNdist 2))
	endPntMN   (polar BotPnt 0 (/ MNdist 2))
  )
  (setq MN (AddLwpolyline (list startPntMN endPntMN) 0 mspace))
  ;; Xac dinh 2 duong giong tu MN den PQ
  (setq	pnt0 (vlax-curve-getClosestPointTo PQ startPntMN)
	pnt1 (vlax-curve-getClosestPointTo PQ endPntMN)
  )
  (setq	lwp0 (AddLwpolyline (list startPntMN pnt0) 0 mspace)
	lwp1 (AddLwpolyline (list endPntMN pnt1) 0 mspace)
  )
  ;; Kiem tra dien tich
  (setq AreaLst (CalArea pnt0 startPntMN endPntMN pnt1))
  (setq	s0 (nth 0 AreaLst)
	s1 (nth 1 AreaLst)
	s2 (nth 2 AreaLst)
	s3 (nth 3 AreaLst)
  )
  (if (and (< s0 s1)
	   (< s3 s2)
      )
    (progn
      (alert "Khong the dieu chinh!")
      (reset)
      (exit)
    )
  )
  ;; Can bang so bo 1 cap dien tich
  (textscr)
  (setq iY (- 0 (/ (distance startPntMN pnt0) 20)))
					; buoc nhay phuong doc
  (setq fuzz 0.01)			; do chinh xac dien tich
  (setq	FromPnt	(vlax-3d-point pnt0)
	ToPntY	(vlax-3d-point (polar pnt0 (/ pi 2) iY))
  )
  (while (and (>= (nth 0 AreaLst) (nth 1 AreaLst))
	      (>= (nth 3 AreaLst) (nth 2 AreaLst))
	 )
    (vla-move PQ FromPnt ToPntY)
    (setq pnt0 (polar pnt0 (/ pi 2) iY)
	  pnt1 (polar pnt1 (/ pi 2) iY)
    )
    (setq AreaLst (reverse (CalArea pnt0 startPntMN endPntMN pnt1)))
  )
  (if (> (- (nth 0 AreaLst) (nth 1 AreaLst))
	 (- (nth 3 AreaLst) (nth 2 AreaLst))
      )
    (setq i0 3
	  i1 2
	  i2 1
	  i3 0
    )
    (setq i0 0
	  i1 1
	  i2 2
	  i3 3
    )
  )
  (setq sub32 (- (nth i3 AreaLst) (nth i2 AreaLst)))
  ;; Can bang dien tich dua tren dich chuyen PQ
  (while (not (equal (- (nth i3 AreaLst) (nth i2 AreaLst)) 0.0 fuzz))
    (vla-move PQ
	      (vlax-3d-point pnt0)
	      (vlax-3d-point (polar pnt0 (/ pi 2) iY))
    )
    (setq pnt0 (polar pnt0 (/ pi 2) iY)
	  pnt1 (polar pnt1 (/ pi 2) iY)
    )
    (setq iX 0.1)			; buoc nhay phuong ngang
    (setq AreaLst (reverse (CalArea pnt0 startPntMN endPntMN pnt1)))
    (setq sub01 (- (nth i0 AreaLst) (nth i1 AreaLst)))
    (setq FromPnt (vlax-3d-point pnt0)
	  ToPntX  (vlax-3d-point (polar pnt0 0 iX))
    )
    ;; Can bang dien tich dua tren dich chuyen MN
    (while (not (equal (- (nth i0 AreaLst) (nth i1 AreaLst)) 0.0 fuzz))
      (vla-move MN FromPnt ToPntX)
      (vla-move lwp0 FromPnt ToPntX)
      (vla-move lwp1 FromPnt ToPntX)
      (setq pnt0       (polar pnt0 0 iX)
	    pnt1       (polar pnt1 0 iX)
	    startPntMN (polar startPntMN 0 iX)
	    endPntMN   (polar endPntMN 0 iX)
      )
      (setq AreaLst (reverse (CalArea pnt0 startPntMN endPntMN pnt1)))
      (setq sub01new (- (nth i0 AreaLst) (nth i1 AreaLst)))
      (if (> (abs sub01new) (abs sub01))
	(setq iX (/ (- 0 iX) 2))
      )
      (setq sub01 sub01new)
      (setq FromPnt (vlax-3d-point pnt0)
	    ToPntX  (vlax-3d-point (polar pnt0 0 iX))
      )
    )
    (setq sub32new (- (nth i3 AreaLst) (nth i2 AreaLst)))
    (if	(> (abs sub32new) (abs sub32))
      (setq iY (/ (- 0 iY) 2))
    )
    (setq sub32 sub32new)
    (print AreaLst)
  )
  (vla-zoomprevious (vlax-get-acad-object))
  (reset)
  (princ)
)
(defun reset ()
  (if (= isFliped 1)
    (progn
      (foreach obj (list lwpObj MN PQ lwp0 lwp1)
	(vla-mirror
	  obj
	  (vlax-3d-point startPnt)
	  (vlax-3d-point (polar startPnt 0 0.1))
	)
	(vla-delete obj)
      )
    )
  )
  (vla-endundomark thisdrawing)
  (graphscr)
)
(defun CalArea (p0 p1 p2 p3 / AreaLst tmpLwp)
  (setq	p0 (polar p0 (* pi 1.25) 0.1)
	p1 (polar p1 (* pi 0.25) 0.1)
	p2 (polar p2 (* pi 0.75) 0.1)
	p3 (polar p3 (* pi 1.75) 0.1)
  )
  (foreach pt (list p0 p1 p2 p3)
    (command ".boundary" pt "")
    (setq tmpLwp (vlax-ename->vla-object (entlast)))
    (setq AreaLst (cons (vlax-get-property tmpLwp 'AREA) AreaLst))
    (vla-delete tmpLwp)
  )
  AreaLst
)
(defun LM:Intersections	(obj1 obj2 mode / l r)
  (setq l (vlax-invoke obj1 'intersectwith obj2 mode))
  (repeat (/ (length l) 3)
    (setq r (cons (list (car l) (cadr l) (caddr l)) r)
	  l (cdddr l)
    )
  )
  (reverse r)
)

(defun AddLwpolyline (lst-pnt layer *model-space* / array-pt myPline)
  (setq	array-pt (list->variantArray
		   (apply 'append (mapcar '3dPnt->2dPnt lst-pnt))
		 )
	myPline	 (vla-AddLightWeightPolyline *model-space* array-pt)
  )
  (vla-put-layer myPline layer)
  myPline
)

(defun list->variantArray (ptsList / arraySpace sArray)
  (setq	arraySpace
	 (vlax-make-safearray
	   vlax-vbdouble
	   (cons 0
		 (- (length ptsList) 1)
	   )
	 )
  )
  (setq sArray (vlax-safearray-fill arraySpace ptsList))
  (vlax-make-variant sArray)
)

(defun 3dPnt->2dPnt (3dpt)
  (list (float (car 3dpt)) (float (cadr 3dpt)))
)

(defun LM:CurveMinMax
		      (obj	     fuzz	   /
		       _GetBoundingBoxWithOffset   _GroupByNum
		       _FlattenPoint a		   acdoc
		       acspc	     lst	   obj
		       tmp
		      )

  (defun _GetBoundingBoxWithOffset (obj o / ll ur)
    (
     (lambda (a)
       (mapcar
	 (function
	   (lambda (b)
	     (mapcar
	       (function
		 (lambda (c) ((eval c) a))
	       )
	       b
	     )
	   )
	 )
	 '(
	   (
	    (lambda (x) (- (caar x) o))
	    (lambda (x) (- (cadar x) o))
	   )
	   (
	    (lambda (x) (+ (caadr x) o))
	    (lambda (x) (- (cadar x) o))
	   )
	   (
	    (lambda (x) (+ (caadr x) o))
	    (lambda (x) (+ (cadadr x) o))
	   )
	   (
	    (lambda (x) (- (caar x) o))
	    (lambda (x) (+ (cadadr x) o))
	   )
	  )
       )
     )
      (mapcar 'vlax-safearray->list
	      (progn (vla-getboundingbox obj 'll 'ur) (list ll ur))
      )
    )
  )

  (defun _GroupByNum (l n / r)
    (if	l
      (cons
	(reverse (repeat n
		   (setq r (cons (car l) r)
			 l (cdr l)
		   )
		   r
		 )
	)
	(_GroupByNum l n)
      )
    )
  )

  (defun _FlattenPoint (p)
    (list (car p) (cadr p) 0.0)
  )

  (setq	acdoc (vla-get-activedocument (vlax-get-acad-object))
	acspc (vlax-get-property
		acdoc
		(if (= 1 (getvar 'CVPORT))
		  'Paperspace
		  'Modelspace
		)
	      )
  )
  (cond
    ((not (vlax-method-applicable-p obj 'GetBoundingBox))
    )
    (t
     (setq tmp
	    (mapcar
	      (function
		(lambda	(x)
		  (apply 'vla-addline (cons acspc (mapcar 'vlax-3D-point x)))
		)
	      )
	      (_GroupByNum
		(mapcar	'_FlattenPoint
			(_GetBoundingBoxWithOffset obj (- fuzz))
		)
		2
	      )
	    )
     )
     (setq lst
	    (mapcar
	      (function
		(lambda	(x)
		  (car
		    (_GroupByNum
		      (vlax-invoke obj 'Intersectwith x acExtendOtherEntity)
		      3
		    )
		  )
		)
	      )
	      tmp
	    )
     )
     (mapcar 'vla-delete tmp)
     lst
    )
  )
)

    File bản vẽ test

    http://www.cadviet.com/upfiles/3/86115_test.dwg

     

    Cảm ơn bạn. Chạy được rùi. Nhưng bạn có thể giúp mình sửa nó để có thể áp dụng vào bài sau được không .

    123.png

    Yêu cầu: Đó là, cái đường điều phối ta vẽ trước đó, từ đó ta xác định nó cắt tại bao nhiêu điểm, như hình trên thì ta có 5 khối .Sau đó vẫn như yêu cầu trên là tìm vị trí đường điều phối mà cả 5 khối đó đều thỏa mãn các điều kiện như trước (đoạn MN của các khối không bằng nhau nhưng phải <= L cố định ). Sau khi tính xong thì ta phải được một hình hoàn chỉnh như khối 1 ( Có hatch, ghi kích thước ) .

  6. Đã đăng · Trả lời báo cáo

     

     

    Lâu lắm mới thấy có đề bài hay, bạn vẽ thêm trường hợp tổng quát hơn ấy, như bạn nói có thể có 2*n vùng thì phải mà, lúc đó cách tính như thế nào?

     

    Untitled5555.png

    Đây là một trường hợp phức tạp hơn. Đó là cùng 1 đường điều phối sẽ cắt đường tích lũy tại nhiều đoạn. Như hình trên là 3 đoạn, khi đó ta phải xá định để đảm bảo W1= W2 và Các đoạn Mi, Ni luôn < L cố định nào đó .

  8. Đã đăng · Trả lời báo cáo

    Thật sự là bài toán rất khó!

     

    Nếu xét về mặt toán học thuần túy, ta có thể gắn thêm hệ trục 2D, đường cong tích lũy là một đường cong xác định bằng một phương trình f(x;y), cho trước B (như vậy bài toán có 2 ẩn số: [1] là cao độ đường điều phối & [2] là hoành độ điểm M (nói là hoành độ N cũng được – vì 2 giá trị này liên đới theo B ) → Khi đó 3 đường thẳng là các đường đơn giản vì song song với hệ trục. Khi đó chúng ta có thể dùng kiến thức tích phân để xác định các diện tích và áp đặt chúng theo 2 điều kiện ban đầu: w1 = w2 /\ w3 = w4 → Rút ra hệ 2 phương trình (phù hợp với yêu cầu 2 ẩn số kể trên!).

     

    Trong thực tế – làm sao mặt đất lại có thể “thông minh” tự nhiên nằm nghiệm đúng theo 1 đường cong trơn, có thể chỉ là một Pline → Từ Pline ta có thể hồi quy về một đường cong trơn (có thể áp dụng phương pháp bình phương cực tiểu độ lệch – nhưng nghe có vẻ xa vời quá!) Như vậy, về mặt toán học thuần túy – bài toán mang tính khả dĩ.

     

    Nếu viết chương trình AutoLISP thì quả khó thật, tùy thuộc vào đường cong và tốc độ di chuyển (quét) của 2 chùm đường (phụ thuộc vào bước nhảy (move+offset) của từng nhóm), chưa chắc gì đã hội tụ, có khi nó trở thành một cuộc chạy đua, kẻ trước người sau cùng nhau vượt qua mốc mà nếu cùng gặp nhau tại đó bài toán có thể hội tụ, dấu hiệu nào để kẻ đi trước biết được mà quay đầu lại để bài toán hội tụ – khó quá!

    Nhưng nếu Garupro có thể chấp nhận thế này thử:

     

    1. Cho H cố định, nghĩa là đường điều phối xác định, nằm ngang cũng được (giả sử xiên cũng được).

    2. Cho B biến đổi, để 2 đường thẳng qua M và N tự do di chuyển, không còn ràng buộc nhau bằng B.

     

    Khi đó, bài toán có thể giải quyết được, tôi tạm gọi là phương pháp “dao động tắt dần”. Và chúng ta giải quyết bằng một cách chung cho cả 2 nhánh đường cong, như sau:

     

    22665_h1.jpg

     

    Giá trị nhập:

    1. Nhánh đường cong có giới hạn.

    2. Đoạn thẳng đại diện của chùm đường thẳng.

    3. Hướng di chuyển và bước di chuyển đầu tiên.

    4. Độ chính xác yêu cầu của kết quả.

     

    Giải thuật sơ lược:

    1. Viết một vòng lặp, trong đó ứng với mỗi bước đoạn thẳng di chuyển (tịnh tiến = move+offset) một bước: @ = i, tại mỗi vị trí xác định hiệu số: A = [s2 – S1] (vì theo hình vẽ đoạn thẳng di chuyển từ biên trái sang phải → ban đầu S2 > S1), vòng lặp chạy đến khi hiệu số A đổi dấu (từ + sang –), dừng vòng lặp.

    2. Bắt đầu một vòng lặp mới, trong đó đoạn thẳng di chuyển theo hướng ngược lại hướng ban đầu với bước: @ = i/2, tại mỗi vị trí lại xác định hiệu số: A = [s2 – S1], vòng lặp chạy đến khi hiệu số A đổi dấu (từ – sang +), dừng vòng lặp.

    3. Tiếp tục một vòng lặp mới với bước @ = i/4 , v.v...

    4. Mãi đến khi hiệu số: A = [s2 – S1] < độ chính xác yêu cầu thì mặc nhiên dừng lại, in đoạn thẳng tại vị trí dừng ra màn hình. Đó chính là kết quả bài toán.

    P/S: Vì biên độ di chuyển sau mỗi lần đảo chiều của đoạn thẳng luôn nhỏ hơn lần trước – Vì vậy nên tôi gọi là “dao động tắt dần”.

     

    @ Vì không biết mục đích Garupro sử dụng LISP này vào trường hợp cụ thể nào – nên mình mạo muội – mong các bạn đừng cho là spam! Mời các Mem tiếp tục viết giúp bạn í!

     

    Cảm ơn bạn theo cách của bạn thì đoạn MN sẽ không còn chiều dài cố định nữa, và đường điều phối mình phải tự vạch. Cách này thì trước đây mình có hỏi và hiện tại đã giải quyết được. Giờ mình muốn nó tự xác định cái đường PQ thỏa mãn 2 điều kiện W1=W2 ^ W3=W4 và MN không đổi cơ nhưng mình nghĩ là sẽ có trường hợp cả hai không hội tụ tại 1 điểm  vậy thử theo hướng khác xem : Là MN không cố định nữa mà có chiều dài phải <= 1 đoạn L nào đó (Do mình nhập) liệu có được không nhỉ. Còn nếu vẫn khó khăn thì ta phải xét đến trường hợp là người dùng tự kẻ đường PQ, sau đó tự phân chia W1=W2 ^ W3=W4 và thỏa mãn MN <= L như vậy bài toán chắc đơn giản hơn. Các bạn xem giúp mình. Thank

  10. Đã đăng · Trả lời báo cáo

    Đây chỉ là 1 trường hợp đơn giản các bạn ah. Còn có trường hợp là đường PQ không chỉ cắt tại 2 điểm mà cắt tại nhiều điểm khi đó không chỉ có W1=W2, W3=W4 đâu mà còn W5=W6, W7=W8... khi đó xuất hiện thêm các đoạn MN khác nhau nằm trên hoặc dưới PQ. Nói thật đây là bài toán rất khó mình chưa tìm được cách giải nào mà vừa chính xác và đỡ tốn time , như bạn Doan Van Ha nói thì cái này phải nói là để tính xong rất tốn time luôn. Kiểu này chắc mình làm 2 cái nút một cái để dịc PQ lên xuống, 1 cái để dịch MN sang trai hoặc phải với bước nhảy do người dùng nhập vào. Chứ tự động hoàn toàn nghe có vẻ bất khả thi rùi

     

  11. Đã đăng · Trả lời báo cáo

    Mình có hình minh họa như thế này.

     

    11111.PNG

     

    Yêu cầu như sau :

     Đường MN có Lbq là cố định. Ta phải chia đều sao cho diện tích W1= W2; W3= W4 bằng cách dịch MN sang trái or phải và PQ lên or xuống

    Đường màu đỏ là Pline các đường khác đều là Line

    Bạn nào có ý tưởng nào không tư vấn cho mình chút . cảm ơn các  bạn nhiều

     

     

    • Vote tăng 2

  12. Đã đăng · Trả lời báo cáo

    Chưa Hide From là sao bạn?

    Có thể nói rõ dùm mình được không?

    Tức là bạn phải ẩn cái Form đi thì mới click trên Cad để lấy tọa độ được chứ , sau khi lấy xong thì bạn lại Show nó lên

    Đối với các hàm ThisDrawing.Utility.GetPoint ,ThisDrawing.Utility.GetAngle,ThisDrawing.Utility.GetEntity....Thì bạn phải Hide cái form đi , thì mới thao tác với Cad được

     

    Cụ thể với cái Sub bạn đưa ở trên , mình copy về và chạy ngon không vấn đề gì

     

    Bạn thử đặt đoạn Code sau vào sự kiện Click của Button :

    Private Sub CommandButton1_Click()
Me.Hide
Ch3_CalculateDefinedArea
Me.Show
End Sub

  16. Đã đăng · Trả lời báo cáo

    Cái vụ này mình không biết có phương pháp nào hay hơn nhanh hơn để làm không , nhưng mình có phương pháp như thế này , đi đường vòng thui :

    Thứ nhất điểm đó nằm trên Pline : Pline thực chất là các Line ghép lại mà thành . Để xác định nó có thuộc không bạn chỉ cần xét tất cả các line đó là được (Bạn duyệt 2 điểm 1 của Pline , viết PT đường thẳng rùi xét nó có thuộc không thui)

    Còn vấn đề nằm trong hay nằm ngoài : Thì hơi khó . bạn thử giải quyết theo cách này xem .Dùng chính hàm tạo Boundary ở trên để tạo 1 Pline . Sau đó so sánh thằng Pline đó với thằng này (Diện tích chẳng hạn) thì bạn biết ngay nó nằm trong hay nằm ngoài mà (nằm trong đương nhiên ta dược 1 pline y xì thằng đang xét , còn nằm ngoài có thể có Pline khác or không . Va đương nhiên thằng đó sẽ khác thằng đang xét .Cũng có thể xảy ra trường hợp giống nhau , nhưng rất ít , và cách này chỉ áp dụng với Pline khép kín thui ) . Bạn nghiên cứu thử xem , mình cũng chưa có thử . Chúc bạn thành công

  18. Đã đăng · Trả lời báo cáo

    Trong VBA mình thấy có BOUNDARY nhưng lại không thấy cách để tạo ra nó .Lên đành sử dụng SendCommand , đưa tọa độ thuộc 1 vùng kín vào , và ta lấy đối tượng được tạo ra sau cùng của bản vẽ .Bạn tham khảo thử :

    Tạo Region :

    Function Taoregion(x As Double, y As Double) As AcadRegion
  ThisDrawing.SendCommand ("-Boundary" & vbCr & "A" & vbCr & "o" & vbCr & "R" & vbCr & vbCr & x & "," & y & vbCr & vbCr)
  Set Taoregion = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.count - 1)
End Function

     

    Tạo Polyline

     

    Function Taopolyline(x As Double, y As Double) As AcadLWPolyline
  ThisDrawing.SendCommand ("-Boundary" & vbCr & "A" & vbCr & "o" & vbCr & "P" & vbCr & vbCr & x & "," & y & vbCr & vbCr)
  Set Taopolyline = ThisDrawing.ModelSpace.Item(ThisDrawing.ModelSpace.count - 1)
End Function

  19. Đã đăng · Trả lời báo cáo

    Bạn chỉ cần lấy tất cả các điểm rồi tính chiều dài = điểm trước - điểm sau

     

    Sub get_D()
Dim Entry As AcadObject
Dim point As Variant
Dim pline As AcadLWPolyline
Dim cor As Variant
Dim x1 As Double, y1 As Double, x2 As Double, y2 As Double
ThisDrawing.Utility.GetEntity Entry, point, "Chon mot Pline "
If Entry.ObjectName = "AcDbPolyline" Then
  Set pline = Entry
  cor = pline.Coordinates
  For I = 0 To UBound(cor) - 2 Step 2
 	x1 = cor(I)
 	y1 = cor(I + 1)
 	x2 = cor(I + 2)
 	y2 = cor(I + 3)
 	MsgBox tinhchieudai(x1, y1, x2, y2)
  Next
End If
End Sub
Function tinhchieudai(x1 As Double, y1 As Double, x2 As Double, y2 As Double) As Double
tinhchieudai = Sqr((x2 - x1) ^ 2 + (y2 - y1) ^ 2)
End Function

    • Vote tăng 1

  20. Đã đăng · Trả lời báo cáo

    Anh không nên "hình sự hóa" và "phức tạp hóa" những vấn đề cỏn con như thế!!!

    Có gì khó khăn lắm đâu, chỉ cần :

    - Gõ lệnh L vẽ 2 phát được 02 đường AB, CD.

    - Gõ lệnh F với tham số mặc định R=0 >> Bấm chọn hai phát >>là ra AE và CE.

    - Gõ lệnh E >>>Xóa CE đi là xong!

    Tất cả những thao tác ứ chỉ tốn có 10 giây, với người mới làm quen với AutoCAD; nhanh hơn rất nhiều khi phải chờ đèn Đỏ đếm ngược, khi đi làm qua ngã tư! Làm gì phải tự mình làm khổ mình thế hả anh????

     

    Bạn đó hỏi là hỏi ở chuyên mục VBA , tại sao các bạn lại trả lời là làm trực tiếp trên Cad , nếu làm trên cad thì cần j

  22. Đã đăng · Trả lời báo cáo

    Bạn chỉ cần luu toan bbooj đối tượng vào 1 mảng rùi , xử ly no thui

    Code hoàn chỉnh đây , chạy Sub soft

     

    Dim sset As AcadSelectionSet
Dim enty As AcadEntity
Sub soft()
'Lay doi tuong
taoselect
'Khoi tao mang de luu cac doi tuong
Dim enty() As AcadEntity
'Gan doi tuong cho mang
ReDim enty(sset.count)
For I = 0 To sset.count - 1
Set enty(I) = sset(I)
Next
'Sap xep
'Khai bao doi tuong
Dim text As AcadText
Dim mtext As AcadMText
'Xac dinh truc sap xep
Dim truc As String
  truc = "X"
chonlai:
  truc = ThisDrawing.Utility.GetString(0, "Chon Truc Can Chinh X Or Y [X]:")
  If truc <> "" Then
  If UCase(truc) <> "X" Then
	If UCase(truc) <> "Y" Then
  	GoTo chonlai
	End If
  End If
  Else
  truc = "X"
  End If
  truc = UCase(truc)
'Khai bao diem
Dim p1 As Double
Dim p2 As Double
Dim diem As Variant
'Bien trung gian
Dim enty_tg As AcadEntity
'Sap xep theo kieu noi bot
For I = 0 To UBound(enty) - 1
 If enty(I).ObjectName = "AcDbText" Then
Set text = enty(I)
diem = text.insertionPoint
	If truc = "X" Then
   	p1 = diem(0)
   	Else
   	p1 = diem(1)
	End If
  End If
  If enty(I).ObjectName = "AcDbMText" Then
Set mtext = enty(I)
diem = mtext.insertionPoint
	If truc = "X" Then
   	p1 = diem(0)
   	Else
   	p1 = diem(1)
	End If
  End If



 For j = I + 1 To UBound(enty) - 1
  If enty(j).ObjectName = "AcDbText" Then
Set text = enty(j)
diem = text.insertionPoint
	If truc = "X" Then
   	p2 = diem(0)
   	Else
   	p2 = diem(1)
	End If
  End If
  If enty(j).ObjectName = "AcDbMText" Then
Set mtext = enty(j)
diem = mtext.insertionPoint
	If truc = "X" Then
   	p2 = diem(0)
   	Else
   	p2 = diem(1)
	End If
  End If
 'So xanh toa do 2 diem va doi vi tri
  If p1 > p2 Then
	Set enty_tg = enty(I)
	Set enty(I) = enty(j)
	Set enty(j) = enty_tg
  End If
Next
Next
'Su ly cai mang da xap xep
'Khai bao tien to , hau to
Dim tiento As String
Dim hauto As String
Dim vt_batdau As Integer
tiento = ThisDrawing.Utility.GetString(1, "Nhap Tien To :")
hauto = ThisDrawing.Utility.GetString(1, "Nhap Hau To :")
'Lay vi tri bat dau
vt_batdau = Get_Star
Dim tt As String
Dim text_them As String
'Duyet tung doi tuong va thay the text
For I = 0 To UBound(enty) - 1
  text_them = tiento & I + vt_batdau & hauto
If enty(I).ObjectName = "AcDbText" Then
Set text = enty(I)
 	tt = tachtext(text.textString)
 	text.textString = Replace(text.textString, tt, text_them)
End If
If enty(I).ObjectName = "AcDbMText" Then
Set mtext = enty(I)
 	tt = tachtext(mtext.textString)
 	mtext.textString = Replace(mtext.textString, tt, text_them)
End If
Next
Application.Update
End Sub

Function Get_Star() As Integer
 On Error GoTo thoat
Get_Star = ThisDrawing.Utility.GetInteger("Nhap Vi tri Bat Dau [0]:")
Exit Function
thoat:
 thoat = 0
End Function

Function tachtext(t As String) As String
 On Error Resume Next
 Dim a As Long
 a = InStrRev(t, ";")
 t = Mid(t, a + 1)
 If t Like "*}*" = True Then
 a = InStr(t, "}")
 Else
  a = InStr(t, "\")
  End If
 t = Mid(t, 1, a - 1)
 tachtext = t
 End Function

Sub taoselect()
Dim Ftype1(3) As Integer
  Dim Fdata1(3) As Variant
  On Error Resume Next
  Set sset = ThisDrawing.SelectionSets("sset2")
  If Err <> 0 Then
  Err.Clear
  Set sset = ThisDrawing.SelectionSets.Add("sset2")
  Else
  sset.Clear
  End If
  Ftype1(0) = -4
  Fdata1(0) = "<or"
  Ftype1(1) = 0
  Fdata1(1) = "TEXT"
  Ftype1(2) = 0
  Fdata1(2) = "MTEXT"
  Ftype1(3) = -4
  Fdata1(3) = "or>"
  sset.SelectOnScreen Ftype1, Fdata1
End Sub

    • Vote tăng 2

  24. Đã đăng · Trả lời báo cáo

    Mình có ý tưởng thế này , Có 1 Pline đi qua nhiều điểm , biết 2 điểm A, B thuộc Pline đó , từ A,B ta chắc chắn sẽ dựng được 2 đường line 1,line2 //trục X , vấn đề ở đây là làm sao để dựng được Line 3 với điều kiện diện tích S1=S2

     

    Mình có thoáng qua ý tưởng như thế này : Qua 2 điểm A,B ta xác định nó thuộc đoạn nào của Pline , từ 2 điểm này chắc chắn sẽ vẽ được Line1,Line 2 có chiều dài từ A-B, sau đó Dựng tạm đường 3 gần phía A,or B sau đó dùng vòng lặp để dich Line 3 tịnh tiến 1 khoảng nhỏ , dần dần , mỗi lần dich ta xac định được giao điểm của nó với ba đường còn lại từ các điểm đã biết ta dựng được các Pline khép kín S1,S2 và đo diện tích nếu bằng nhau (Sai số trong 1 khoảng nào đó) thì dừng .

     

    BVanj nào có ý nào hay hơn thì góp y cho mình nha .Rất cám ơn các bạn

     

    Capture-16.png

×