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

Lisp xuất tọa độ của Polyline trong CAD theo ý mong muốn

Bởi doantuangt , trong AutoLisp

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

huunhantvxdts    195

huunhantvxdts
Đã đăng
10 giờ trước, doantuangt đã nói:

Mình muốn xin lisp xuất tọa độ của polyline trong CAD theo thứ tự điểm mình mong muốn. Theo hình đính kèm. Cám ơn nhiều!

image.png.556bbbf3b9ef2b219d1ff89e2fb35654.png

Hàm để lấy tọa độ polyline 

(defun laytoado (sset / lsttd toado)
			(setq hnd (car sset))
            (setq ent (entget hnd))
            (setq obj (cdr (assoc 0 ent)))
            (cond
              ((= obj "LWPOLYLINE")
                (foreach rec ent
                  (if (= (car rec) 10)
                    (progn
                      (setq pnt (cdr rec))
                      (setq toado (list (car pnt) (cadr pnt)))
					  (setq lsttd (cons toado lsttd))
					)
                  )
                )
              )
            )
lsttd
)
(defun C:LTD (/ dtpl toadopl)
(setq dtpl (entsel "\nChon pl"))
(setq toadopl (laytoado dtpl))
)

 

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

congviet    29

congviet
Đã đăng
2 giờ trước, doantuangt đã nói:

Mình muốn lấy theo thứ tự như hình 1 >2>....điểm cuối. mà không phải pick từng điểm. Có cách nào ko bạn?

Bạn thử cái này xem.

LTD để lấy tọa độ từ điểm đầu tới điểm cuối (1->2)
LTDR để lấy tọa độ từ điểm cuối tới điểm đầu (2->1)
 

Lay_Toa_Do_LDT.lsp

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

Danh Cong    422

Danh Cong
Đã đăng
27 phút trước, congviet đã nói:

Bạn thử cái này xem.

LTD để lấy tọa độ từ điểm đầu tới điểm cuối (1->2)
LTDR để lấy tọa độ từ điểm cuối tới điểm đầu (2->1)

Lay_Toa_Do_LDT.lsp

Hình như  chủ thớt không phải lấy tọa độ từ đầu ---> Cuối polyline đâu ^^ :;):;)

+ So sánh X nhỏ, lấy ra được 1, 4. So sánh tiếp Y thì phân biệt được 1, 4.

+ So sánh X lớn, lấy được 2, 3. So sánh tiếp Y thì phân biệt được 2, 3.

 

14 phút trước, doantuangt đã nói:

Sao dùng lisp bạn gửi không được nhỉ? Không chọn được đường Polyline. :(((

Bạn chủ thớt bật F2 lên để thấy được kết quả nhé.

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

doantuangt    1

doantuangt
Đã đăng

Ý của mình là có 1 đường polyline kín như hình, mình muốn lấy tọa độ mà khi xuất ra file excel theo thứ tự ưu tiên từ Trái qua phải và từ trên xuống dưới, theo đúng vòng tròn chiều kim đồng hồ. AI giúp mình với

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

Bee    154

Bee
Đã đăng

Search là đầy file mà. Sau đó Open trong excel phân column bằng comma. 

(defun vert (/		 filterlist  vla-obj-list
	     lwlist	 2dlist	     ptlist	 vlist1
	     vlist2	 vlist3
	    )
  (vl-load-com)
  (setq	filterlist   (make-filter)
	vla-obj-list (get-objects filterlist)
	lwlist	     (nth 0 vla-obj-list)
	2dlist	     (nth 1 vla-obj-list)
	ptlist	     (nth 2 vla-obj-list)
	vlist1	     nil
	vlist2	     nil
	vlist3	     nil
  ) ;_ end-of setq
  (if lwlist
    (setq vlist1 (make-list lwlist 2))
  ) ;_ end of if
  (if 2dlist
    (setq vlist2 (make-list 2dlist 3))
  ) ;_ end of if
  (if ptlist
    (setq vlist3 (make-list ptlist 3))
  ) ;_ end of if
  (write-text vlist1 vlist2 vlist3)
  (princ)
) ;_ end of vert

(defun make-list (p-list n / i vlist obj coords ca j x y z xy)
  (setq	i (- 1)
	vlist nil
  ) ;_ end of setq
  (repeat (length p-list)
    (setq obj	 (nth (setq i (1+ i)) p-list)
	  coords (vlax-get-property obj "coordinates")
	  ca	 (vlax-variant-value coords)
	  j	 (- 1)
    ) ;_ end-of setq
    (repeat (/ (length (vlax-safearray->list ca)) n)
      (setq x (vlax-safearray-get-element ca (setq j (1+ j))))
      (setq y (vlax-safearray-get-element ca (setq j (1+ j))))
      (if (= n 2)
	(setq xy (list x y))
	(progn
	  (setq z (vlax-safearray-get-element ca (setq j (1+ j))))
	  (setq xy (list x y z))
	) ;_ end of progn
      ) ;_ end of if
      (setq vlist (append vlist (list xy)))
    ) ;_ end-of repeat
  ) ;_ end-of repeat
) ;_ end-of make-list

(defun make-filter (/ filter)
  (setq	filter '((-4 . "<OR")
		 (0 . "LWPOLYLINE")
		 (0 . "POLYLINE")
		 (0 . "POINT")
		 (-4 . "OR>")
		)
  ) ;_ end of setq
) ;_ end of make-filter

(defun get-objects (filter  /	    ss	    k	    lwp-list
		    2dp-list	    pt-list no-ent  obj	    pl
		    2d	    pt
		   )
  (setq no-ent 1)
  (while no-ent
    (setq ss	   (ssget filter)
	  k	   (- 1)
	  lwp-list nil
	  2dp-list nil
	  pt-list  nil
	  obj	   nil
	  pl	   "AcDbPolyline"
	  2d	   "AcDb2dPolyline"
	  pt	   "AcDbPoint"
    ) ;_ end-of setq
    (if	ss
      (progn
	(setq no-ent nil)
	(repeat	(sslength ss)
	  (setq	ent (ssname ss (setq k (1+ k)))
		obj (vlax-ename->vla-object ent)
	  ) ;_ end-of setq
	  (cond
	    ((= (vlax-get-property obj "ObjectName") pl)
	     (setq lwp-list (append lwp-list (list obj)))
	    )
	    ((= (vlax-get-property obj "ObjectName") 2d)
	     (setq 2dp-list (append 2dp-list (list obj)))
	    )
	    ((= (vlax-get-property obj "ObjectName") pt)
	     (setq pt-list (append pt-list (list obj)))
	    )
	  ) ;_ end-of cond
	) ;_ end-of repeat
      ) ;_ end-of progn
      (prompt "\nNo polylines or points selected, try again.")
    ) ;_ end-of if
  ) ;_ end-of while
  (list lwp-list 2dp-list pt-list)
) ;_ end-of get-objects

(defun write-text (vl1 vl2 vl3)
  (setq	fn (getfiled "Text File" "" "txt" 1)) 
  (setq f (close (open fn "w")))
  (setq msg "Points from LW-Polylines")
  (do-points fn vl1 msg 2)
  (setq msg "Points from 2d-Polylines")
  (do-points fn vl2 msg 3)
  (setq msg "Points from Point entities")
  (do-points fn vl3 msg 3)
  (princ)
) ;_ end of write-text

(defun do-points (fn vl msg n)
  (setq f (open fn "a"))
  (write-line msg f)
  (write-line "  x,  y,  z" f)
  (write-line "" f)
  (foreach point vl
    (setq x (nth 0 point)
	  y (nth 1 point)
    ) ;_ end of setq
    (if	(= n 2)
      (setq str (strcat (rtos x) "," (rtos y)))
      (progn
	(setq z (nth 2 point))
	(setq str (strcat (rtos x) "," (rtos y) "," (rtos z)))
      ) ;_ end of progn
    ) ;_ end of if
    (write-line str f)
  ) ;_ end of foreach
  (setq f (close f))
  (princ)
) ;_ end of defun

(defun c:pts ()
  (vert)
  (princ)
) ;_ end-of defun

(prompt "PLIST.LSP by Tony Hotchkiss - enter PTS to start ")

image.png.8ed4dd591033547a719327b677e23fc3.png

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
Về Đầu Trang AutoLisp
×