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

Xin hỗ trợ lisp tự động click điểm vào các mắt lưới

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

Chào các bác. Em muốn nhờ các bác hỗ trợ lisp tự động click điểm vào các mắt lưới trong giới hạn đường bao.

Ví dụ là em muốn copy đường tròn màu đỏ (DO) vào đúng vị trí các mắt lưới trong giới hạn đường bao. E click thủ công mà lâu quá. Mong nhận được sự quan  tâm hỗ trợ từ các bác.

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

Chào các bác. Em muốn nhờ các bác hỗ trợ lisp tự động click điểm vào các mắt lưới trong giới hạn đường bao.

Ví dụ là em muốn copy đường tròn màu đỏ (DO) vào đúng vị trí các mắt lưới trong giới hạn đường bao. E click thủ công mà lâu quá. Mong nhận được sự quan  tâm hỗ trợ từ các bác.

Topo.dwg

ezgif.com-video-to-gif.gif.4ec6eff8e30a3f160c86ffcd9eb3dadc.gif

Không biết thế này đã được chưa nhỉ

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

Một trong 2 phương pháp đều ok cả. Làm cách nào hay vậy bác. Chỉ em cách tự động pick vào các mắt lưới với...

(defun @Inside (PIQ	 Object	  /	   ClosestPoint
	ClosestParam	  Sample   Start    End	     P1
	P2	 P	  a1	   a2	    Defl
       )
 (setq Sample 0.2)
 (vl-load-com)
 (or (= (type @delta) 'SUBR)
     (defun @delta (a1 a2)
(cond
  ((> a1 (+ a2 pi))
   (+ a2 pi pi (- a1))
  )
  ((> a2 (+ a1 pi))
   (- a2 a1 pi pi)
  )
  (1 (- a2 a1))
)
     )
 )
 (and
   (cond
     ((not Object)
      (prompt "  No object provided.")
     )
     ((= (type Object) 'VLA-Object))
     ((= (type Object) 'Ename)
      (setq Object (vlax-ename->vla-object Object))
     )
     (1 (prompt "  Improper object type."))
   )
   (or
     (and
(< 1 (vl-list-length PIQ) 4)
(vl-every 'numberp PIQ)
     )
     (prompt " Improper point value.")
   )
   (or
     (not
(vl-catch-all-error-p
  (setq	Start
	 (vl-catch-all-apply
	   'vlax-curve-getStartPoint
	   (list Object)
	 )
  )
)
     )
     (prompt "  Object is not a curve.")
   )
   (or
     (equal Start (vlax-curve-getendpoint Object) 1e-10)
     (prompt "  Curve is not closed.")
   )
   (setq P (trans PIQ 1 0)); PIQ in WCS
   (setq ClosestPoint
   (vlax-curve-getclosestpointto Object P) ; In WCS
   )
   (not (equal P ClosestPoint 1e-10)); in WCS
   (setq ClosestParam (vlax-curve-getparamatpoint Object ClosestPoint))
   (setq ClosestPoint (trans ClosestPoint 0 1)) ; convert to UCS
   (setq End (vlax-curve-getEndparam Object))
   (setq P1   0.0
  P2   Sample
  Defl 0.0
   )
   (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS
   (while (<= P2 End)
     (setq P2 (min P2 End))
       (if (< P1 ClosestParam P2)
(setq a2   (angle PIQ ClosestPoint)
      Defl (+ Defl (@delta a1 a2))
      a1   a2
)
     )

     (while (not (setq P (vlax-curve-getPointAtParam Object P2)))
(setq P2 (+ P2 Sample))
     )
     (setq a2	 (angle PIQ (trans P 0 1)) ; in UCS
    Defl (+ Defl (@delta a1 a2))
    a1	 a2
    P1	 P2
    P2	 (+ P2 Sample)
     )
   )

   (> (abs Defl) 4)
 )
)
(defun C:te (/ ss1 p1 p2 p3 ss t1 lst pt)
 (vl-load-com)
  (Prompt "\nQu\U+00E9t v\U+00F9ng ch\U+1EE9a c\U+00E1c \U+0111i\U+1EC3m giao")
  (setq ss (acet-ss-to-list (ssget (list (cons 0 "LWPOLYLINE")))))
  (if (and ss) (progn			
  (setq t1 0)
  (mapcar '(lambda (x) (if (> (vlax-curve-getendparam x) t1) (progn (setq ent x) (setq t1 (vlax-curve-getendparam x)))) ) ss)
  (setq ss (vl-remove ent ss))
  (setq ss (vl-sort ss '(lambda (x y) (< (vla-get-length (vlax-ename->vla-object x)) (vla-get-length (vlax-ename->vla-object y))))))
  (setq ss1 (list (car ss)) 
	ss (cdr ss))
  (setq p1 (vlax-curve-getpointatparam (car ss1) (vlax-curve-getstartparam (car ss1)))
	p2 (vlax-curve-getpointatparam (car ss1) (+ 1 (vlax-curve-getstartparam (car ss1)) ))
	p3 (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2) (/ (+ (caddr p1) (caddr p2)) 2)))
  (setq lst (getlstpoint ss))
  (foreach pt lst
    (if (@Inside Pt ent)(progn
	(foreach obj ss1
	(vla-Move (vla-Copy (vlax-ename->vla-object obj)) (vlax-3d-point p3) (vlax-3d-point pt))
	  )
      ))
    )
  ))
 (princ)
)
(defun getlstpoint (ss / ent1 lst_pt lst )
(setq lst_pt nil)
  (while (> (length ss) 1)
    (setq ent1 (car ss))
    (setq lst (apply 'append (mapcar '(lambda (x) (vla-inters ent1 x 0)) (cdr ss))))
    (setq lst_pt (append lst_pt lst))
    (setq ss (cdr ss))
    )
  lst_pt
)
(defun vla-inters (ent1 ent2 mode / lst1 lst2)
  (setq lst1 (vlax-invoke (vlax-ename->vla-object ent1) 'intersectwith (vlax-ename->vla-object ent2)
	       (cond
		 ((= mode 0) acextendnone)
		 ((= mode 1) acextendthisentity)
		 ((= mode 2) acextendotherentity)
		 ((= mode 3) acextendboth)
		 )))
  (repeat (/ (length lst1) 3)
    (setq lst2 (cons (list (car lst1) (cadr lst1) (caddr lst1)) lst2)
	  lst1 (cdddr lst1)
	  )
    )
  (reverse lst2)
  )

Áp dụng cho bài toán này oke, còn bài khác thì mình k chịu trách nhiệm nhé bạn ^^ 

  • 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, monavamonava đã nói:

Một trong 2 phương pháp đều ok cả. Làm cách nào hay vậy bác. Chỉ em cách tự động pick vào các mắt lưới với...

1. Cái màu đỏ của bạn là Polyline nên muốn chèn nó vào phải tìm tâm của nó

2. Cần xác định toạ độ các điểm giao mắt lưới

3. Xác định các điểm giao đó nằm trong hay ngoài đường bao xanh.

  • 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
15 giờ trước, Doan Nguyen Van đã nói:

(defun @Inside (PIQ	 Object	  /	   ClosestPoint
	ClosestParam	  Sample   Start    End	     P1
	P2	 P	  a1	   a2	    Defl
       )
 (setq Sample 0.2)
 (vl-load-com)
 (or (= (type @delta) 'SUBR)
     (defun @delta (a1 a2)
(cond
  ((> a1 (+ a2 pi))
   (+ a2 pi pi (- a1))
  )
  ((> a2 (+ a1 pi))
   (- a2 a1 pi pi)
  )
  (1 (- a2 a1))
)
     )
 )
 (and
   (cond
     ((not Object)
      (prompt "  No object provided.")
     )
     ((= (type Object) 'VLA-Object))
     ((= (type Object) 'Ename)
      (setq Object (vlax-ename->vla-object Object))
     )
     (1 (prompt "  Improper object type."))
   )
   (or
     (and
(< 1 (vl-list-length PIQ) 4)
(vl-every 'numberp PIQ)
     )
     (prompt " Improper point value.")
   )
   (or
     (not
(vl-catch-all-error-p
  (setq	Start
	 (vl-catch-all-apply
	   'vlax-curve-getStartPoint
	   (list Object)
	 )
  )
)
     )
     (prompt "  Object is not a curve.")
   )
   (or
     (equal Start (vlax-curve-getendpoint Object) 1e-10)
     (prompt "  Curve is not closed.")
   )
   (setq P (trans PIQ 1 0)); PIQ in WCS
   (setq ClosestPoint
   (vlax-curve-getclosestpointto Object P) ; In WCS
   )
   (not (equal P ClosestPoint 1e-10)); in WCS
   (setq ClosestParam (vlax-curve-getparamatpoint Object ClosestPoint))
   (setq ClosestPoint (trans ClosestPoint 0 1)) ; convert to UCS
   (setq End (vlax-curve-getEndparam Object))
   (setq P1   0.0
  P2   Sample
  Defl 0.0
   )
   (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS
   (while (<= P2 End)
     (setq P2 (min P2 End))
       (if (< P1 ClosestParam P2)
(setq a2   (angle PIQ ClosestPoint)
      Defl (+ Defl (@delta a1 a2))
      a1   a2
)
     )

     (while (not (setq P (vlax-curve-getPointAtParam Object P2)))
(setq P2 (+ P2 Sample))
     )
     (setq a2	 (angle PIQ (trans P 0 1)) ; in UCS
    Defl (+ Defl (@delta a1 a2))
    a1	 a2
    P1	 P2
    P2	 (+ P2 Sample)
     )
   )

   (> (abs Defl) 4)
 )
)
(defun C:te (/ ss1 p1 p2 p3 ss t1 lst pt)
  (Prompt "\nQu\U+00E9t v\U+00F9ng ch\U+1EE9a c\U+00E1c \U+0111i\U+1EC3m giao")
  (setq ss (acet-ss-to-list (ssget (list (cons 0 "LWPOLYLINE")))))
  (if (and ss) (progn			
  (setq t1 0)
  (mapcar '(lambda (x) (if (> (vlax-curve-getendparam x) t1) (progn (setq ent x) (setq t1 (vlax-curve-getendparam x)))) ) ss)
  (setq ss (vl-remove ent ss))
  (setq ss (vl-sort ss '(lambda (x y) (< (vla-get-length (vlax-ename->vla-object x)) (vla-get-length (vlax-ename->vla-object y))))))
  (setq ss1 (list (car ss)) 
	ss (cdr ss))
  (setq p1 (vlax-curve-getpointatparam (car ss1) (vlax-curve-getstartparam (car ss1)))
	p2 (vlax-curve-getpointatparam (car ss1) (+ 1 (vlax-curve-getstartparam (car ss1)) ))
	p3 (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2) (/ (+ (caddr p1) (caddr p2)) 2)))
  (setq lst (getlstpoint ss))
  (foreach pt lst
    (if (@Inside Pt ent)(progn
	(foreach obj ss1
	(vla-Move (vla-Copy (vlax-ename->vla-object obj)) (vlax-3d-point p3) (vlax-3d-point pt))
	  )
      ))
    )
  ))
 (princ)
)
(defun getlstpoint (ss / ent1 lst_pt lst )
(setq lst_pt nil)
  (while (> (length ss) 1)
    (setq ent1 (car ss))
    (setq lst (apply 'append (mapcar '(lambda (x) (vla-inters ent1 x 0)) (cdr ss))))
    (setq lst_pt (append lst_pt lst))
    (setq ss (cdr ss))
    )
  lst_pt
)
(defun vla-inters (ent1 ent2 mode / lst1 lst2)
  (setq lst1 (vlax-invoke (vlax-ename->vla-object ent1) 'intersectwith (vlax-ename->vla-object ent2)
	       (cond
		 ((= mode 0) acextendnone)
		 ((= mode 1) acextendthisentity)
		 ((= mode 2) acextendotherentity)
		 ((= mode 3) acextendboth)
		 )))
  (repeat (/ (length lst1) 3)
    (setq lst2 (cons (list (car lst1) (cadr lst1) (caddr lst1)) lst2)
	  lst1 (cdddr lst1)
	  )
    )
  (reverse lst2)
  )

Áp dụng cho bài toán này oke, còn bài khác thì mình k chịu trách nhiệm nhé bạn ^^ 

Lisp của bác dùng cho video 2 phải không ạ? Sao em ap lisp. Gõ lệnh Te rồi quét mà không ra được nhỉ? Có hỏi chọn quét vùng xong rồi ; error: no function definition: VLAX-CURVE-GETENDPARAM

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

Lisp của bác dùng cho video 2 phải không ạ? Sao em ap lisp. Gõ lệnh Te rồi quét mà không ra được nhỉ? Có hỏi chọn quét vùng xong rồi ; error: no function definition: VLAX-CURVE-GETENDPARAM

Quên mất, bạn thêm dòng (vl-load-com) vào ngay dưới lệnh Defun c:te hoặc ở Command nhé

P/s: Đã thêm vào ở hàm trên

  • 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, Doan Nguyen Van đã nói:

Quên mất, bạn thêm dòng (vl-load-com) vào ngay dưới lệnh Defun c:te hoặc ở Command nhé

P/s: Đã thêm vào ở hàm trên

Cho em hỏi thêm chút. Lisp này có giới hạn phiên bản autocad hay j  nửa không nhỉ.

Em xài trên cad 2005 nó báo lỗi ; error: no function definition: ACET-SS-TO-LIST. Có thể khắc phục nó được không?

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

Cho em hỏi thêm chút. Lisp này có giới hạn phiên bản autocad hay j  nửa không nhỉ.

Em xài trên cad 2005 nó báo lỗi ; error: no function definition: ACET-SS-TO-LIST. Có thể khắc phục nó được không?

Do k có Expresstool, bạn dùng bản này 

(defun @Inside (PIQ	 Object	  /	   ClosestPoint
	ClosestParam	  Sample   Start    End	     P1
	P2	 P	  a1	   a2	    Defl
       )
 (setq Sample 0.2)
 (vl-load-com)
 (or (= (type @delta) 'SUBR)
     (defun @delta (a1 a2)
(cond
  ((> a1 (+ a2 pi))
   (+ a2 pi pi (- a1))
  )
  ((> a2 (+ a1 pi))
   (- a2 a1 pi pi)
  )
  (1 (- a2 a1))
)
     )
 )
 (and
   (cond
     ((not Object)
      (prompt "  No object provided.")
     )
     ((= (type Object) 'VLA-Object))
     ((= (type Object) 'Ename)
      (setq Object (vlax-ename->vla-object Object))
     )
     (1 (prompt "  Improper object type."))
   )
   (or
     (and
(< 1 (vl-list-length PIQ) 4)
(vl-every 'numberp PIQ)
     )
     (prompt " Improper point value.")
   )
   (or
     (not
(vl-catch-all-error-p
  (setq	Start
	 (vl-catch-all-apply
	   'vlax-curve-getStartPoint
	   (list Object)
	 )
  )
)
     )
     (prompt "  Object is not a curve.")
   )
   (or
     (equal Start (vlax-curve-getendpoint Object) 1e-10)
     (prompt "  Curve is not closed.")
   )
   (setq P (trans PIQ 1 0)); PIQ in WCS
   (setq ClosestPoint
   (vlax-curve-getclosestpointto Object P) ; In WCS
   )
   (not (equal P ClosestPoint 1e-10)); in WCS
   (setq ClosestParam (vlax-curve-getparamatpoint Object ClosestPoint))
   (setq ClosestPoint (trans ClosestPoint 0 1)) ; convert to UCS
   (setq End (vlax-curve-getEndparam Object))
   (setq P1   0.0
  P2   Sample
  Defl 0.0
   )
   (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS
   (while (<= P2 End)
     (setq P2 (min P2 End))
       (if (< P1 ClosestParam P2)
(setq a2   (angle PIQ ClosestPoint)
      Defl (+ Defl (@delta a1 a2))
      a1   a2
)
     )

     (while (not (setq P (vlax-curve-getPointAtParam Object P2)))
(setq P2 (+ P2 Sample))
     )
     (setq a2	 (angle PIQ (trans P 0 1)) ; in UCS
    Defl (+ Defl (@delta a1 a2))
    a1	 a2
    P1	 P2
    P2	 (+ P2 Sample)
     )
   )

   (> (abs Defl) 4)
 )
)
;;;;;;*************
(defun C:te (/ ss1 p1 p2 p3 ss t1 lst pt)
  (vl-load-com)
  (Prompt "\nQu\U+00E9t v\U+00F9ng ch\U+1EE9a c\U+00E1c \U+0111i\U+1EC3m giao")
  (setq ss (CV:ss-to-list (ssget (list (cons 0 "LINE,LWPOLYLINE"))) nil))
  (if (and ss) (progn			
  (setq t1 0)
  (mapcar '(lambda (x) (if (> (vlax-curve-getendparam x) t1) (progn (setq ent x) (setq t1 (vlax-curve-getendparam x)))) ) ss)
  (setq ss (vl-remove ent ss))
  (setq ss (vl-sort ss '(lambda (x y) (< (vla-get-length (vlax-ename->vla-object x)) (vla-get-length (vlax-ename->vla-object y))))))
  (setq ss1 (list (car ss)) 
	ss (cdr ss))
  (setq p1 (vlax-curve-getpointatparam (car ss1) (vlax-curve-getstartparam (car ss1)))
	p2 (vlax-curve-getpointatparam (car ss1) (+ 1 (vlax-curve-getstartparam (car ss1)) ))
	p3 (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2) (/ (+ (caddr p1) (caddr p2)) 2)))
  (setq lst (getlstpoint ss))
  (foreach pt lst
    (if (@Inside Pt ent)(progn
	(foreach obj ss1
	(vla-Move (vla-Copy (vlax-ename->vla-object obj)) (vlax-3d-point p3) (vlax-3d-point pt))
	  )
      ))
    )
  ))
 (princ)
)
(defun getlstpoint (ss / ent1 lst_pt lst )
(setq lst_pt nil)
  (while (> (length ss) 1)
    (setq ent1 (car ss))
    (setq lst (apply 'append (mapcar '(lambda (x) (vla-inters ent1 x 0)) (cdr ss))))
    (setq lst_pt (append lst_pt lst))
    (setq ss (cdr ss))
    )
  lst_pt
)
(defun vla-inters (ent1 ent2 mode / lst1 lst2)
  (setq lst1 (vlax-invoke (vlax-ename->vla-object ent1) 'intersectwith (vlax-ename->vla-object ent2)
	       (cond
		 ((= mode 0) acextendnone)
		 ((= mode 1) acextendthisentity)
		 ((= mode 2) acextendotherentity)
		 ((= mode 3) acextendboth)
		 )))
  (repeat (/ (length lst1) 3)
    (setq lst2 (cons (list (car lst1) (cadr lst1) (caddr lst1)) lst2)
	  lst1 (cdddr lst1)
	  )
    )
  (reverse lst2)
  )
(defun CV:ss-to-list (ss vla / n e l)
  (if ss (progn
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (if vla (vlax-ename->vla-object e) e) l))
 )
 ) )
)

 

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
12 phút trước, Doan Nguyen Van đã nói:

Do k có Expresstool, bạn dùng bản này 


(defun @Inside (PIQ	 Object	  /	   ClosestPoint
	ClosestParam	  Sample   Start    End	     P1
	P2	 P	  a1	   a2	    Defl
       )
 (setq Sample 0.2)
 (vl-load-com)
 (or (= (type @delta) 'SUBR)
     (defun @delta (a1 a2)
(cond
  ((> a1 (+ a2 pi))
   (+ a2 pi pi (- a1))
  )
  ((> a2 (+ a1 pi))
   (- a2 a1 pi pi)
  )
  (1 (- a2 a1))
)
     )
 )
 (and
   (cond
     ((not Object)
      (prompt "  No object provided.")
     )
     ((= (type Object) 'VLA-Object))
     ((= (type Object) 'Ename)
      (setq Object (vlax-ename->vla-object Object))
     )
     (1 (prompt "  Improper object type."))
   )
   (or
     (and
(< 1 (vl-list-length PIQ) 4)
(vl-every 'numberp PIQ)
     )
     (prompt " Improper point value.")
   )
   (or
     (not
(vl-catch-all-error-p
  (setq	Start
	 (vl-catch-all-apply
	   'vlax-curve-getStartPoint
	   (list Object)
	 )
  )
)
     )
     (prompt "  Object is not a curve.")
   )
   (or
     (equal Start (vlax-curve-getendpoint Object) 1e-10)
     (prompt "  Curve is not closed.")
   )
   (setq P (trans PIQ 1 0)); PIQ in WCS
   (setq ClosestPoint
   (vlax-curve-getclosestpointto Object P) ; In WCS
   )
   (not (equal P ClosestPoint 1e-10)); in WCS
   (setq ClosestParam (vlax-curve-getparamatpoint Object ClosestPoint))
   (setq ClosestPoint (trans ClosestPoint 0 1)) ; convert to UCS
   (setq End (vlax-curve-getEndparam Object))
   (setq P1   0.0
  P2   Sample
  Defl 0.0
   )
   (setq a1 (angle PIQ (trans Start 0 1))) ; in UCS
   (while (<= P2 End)
     (setq P2 (min P2 End))
       (if (< P1 ClosestParam P2)
(setq a2   (angle PIQ ClosestPoint)
      Defl (+ Defl (@delta a1 a2))
      a1   a2
)
     )

     (while (not (setq P (vlax-curve-getPointAtParam Object P2)))
(setq P2 (+ P2 Sample))
     )
     (setq a2	 (angle PIQ (trans P 0 1)) ; in UCS
    Defl (+ Defl (@delta a1 a2))
    a1	 a2
    P1	 P2
    P2	 (+ P2 Sample)
     )
   )

   (> (abs Defl) 4)
 )
)
;;;;;;*************
(defun C:te (/ ss1 p1 p2 p3 ss t1 lst pt)
  (vl-load-com)
  (Prompt "\nQu\U+00E9t v\U+00F9ng ch\U+1EE9a c\U+00E1c \U+0111i\U+1EC3m giao")
  (setq ss (CV:ss-to-list (ssget (list (cons 0 "LINE,LWPOLYLINE"))) nil))
  (if (and ss) (progn			
  (setq t1 0)
  (mapcar '(lambda (x) (if (> (vlax-curve-getendparam x) t1) (progn (setq ent x) (setq t1 (vlax-curve-getendparam x)))) ) ss)
  (setq ss (vl-remove ent ss))
  (setq ss (vl-sort ss '(lambda (x y) (< (vla-get-length (vlax-ename->vla-object x)) (vla-get-length (vlax-ename->vla-object y))))))
  (setq ss1 (list (car ss)) 
	ss (cdr ss))
  (setq p1 (vlax-curve-getpointatparam (car ss1) (vlax-curve-getstartparam (car ss1)))
	p2 (vlax-curve-getpointatparam (car ss1) (+ 1 (vlax-curve-getstartparam (car ss1)) ))
	p3 (list (/ (+ (car p1) (car p2)) 2) (/ (+ (cadr p1) (cadr p2)) 2) (/ (+ (caddr p1) (caddr p2)) 2)))
  (setq lst (getlstpoint ss))
  (foreach pt lst
    (if (@Inside Pt ent)(progn
	(foreach obj ss1
	(vla-Move (vla-Copy (vlax-ename->vla-object obj)) (vlax-3d-point p3) (vlax-3d-point pt))
	  )
      ))
    )
  ))
 (princ)
)
(defun getlstpoint (ss / ent1 lst_pt lst )
(setq lst_pt nil)
  (while (> (length ss) 1)
    (setq ent1 (car ss))
    (setq lst (apply 'append (mapcar '(lambda (x) (vla-inters ent1 x 0)) (cdr ss))))
    (setq lst_pt (append lst_pt lst))
    (setq ss (cdr ss))
    )
  lst_pt
)
(defun vla-inters (ent1 ent2 mode / lst1 lst2)
  (setq lst1 (vlax-invoke (vlax-ename->vla-object ent1) 'intersectwith (vlax-ename->vla-object ent2)
	       (cond
		 ((= mode 0) acextendnone)
		 ((= mode 1) acextendthisentity)
		 ((= mode 2) acextendotherentity)
		 ((= mode 3) acextendboth)
		 )))
  (repeat (/ (length lst1) 3)
    (setq lst2 (cons (list (car lst1) (cadr lst1) (caddr lst1)) lst2)
	  lst1 (cdddr lst1)
	  )
    )
  (reverse lst2)
  )
(defun CV:ss-to-list (ss vla / n e l)
  (if ss (progn
 (setq n (sslength ss))
 (while (setq e (ssname ss (setq n (1- n))))
(setq l (cons (if vla (vlax-ename->vla-object e) e) l))
 )
 ) )
)

 

Ok. Cảm ơn bác.

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  

×