Chuyển đến nội dung
Diễn đàn CADViet
  • Thông báo

    • Nguyen Hoanh

      CADViet đã hoàn tất nâng cấp   14/09/2017

      Chào các bạn, CADViet đã hoàn tất việc nâng cấp lên phiên bản mới. Tất cả các chức năng đã hoạt động theo kỳ vọng của ban quản trị. Nếu có vấn đề gì cần phản hồi, các bản post ở đây nhé: Trân trọng, Nguyễn Hoành.
Đăng nhập để thực hiện theo  
conghoa

[Request] Chia Spline Thành Polyline Với Khoảng Cách Đỉnh Bằng Nhau.

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

Chào các bạn,

 

Nhờ các bạn giúp mình làm một lisp biến Spline thành Polyline với khoảng cách các đỉnh bằng nhau theo kích thước người dùng nhập vào, nội dung lisp như sau:

 

+Chạy lisp

- Lisp yêu cầu chọn spline cần chia

+Chọn spline (xem lưu ý bên dưới)

- Lisp yêu cầu nhập khoảng cách giữa các đỉnh

+Nhập số giá trị độ dài các đỉnh (ví dụ: 1750 như file đính kèm)

- Lisp sẽ tự động chuyển spline gốc thành polyline theo yêu cầu như hình minh họa bên dưới

 

Lưu ý:

Điểm bắt đầu chia spline có thể xác định bởi vị trí chuột chọn vào đường spline đó:

Ví dụ: nếu điểm chọn spline gần điểm A thì nó bắt đầu chia đường 1750 từ A cho đến B (phần thừa sẽ ở phía Điểm B và ngược lại).

 

1969_spline_to_polyline_1.jpg

 

File cad minh họa

http://www.cadviet.com/upfiles/7/1969_spline_to_polyline.dwg

 

Trân trọng cảm ơn!

  • Vote giảm 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

Chào các bạn,

 

Nhờ các bạn giúp mình làm một lisp biến Spline thành Polyline với khoảng cách các đỉnh bằng nhau theo kích thước người dùng nhập vào, nội dung lisp như sau:

 

+Chạy lisp

- Lisp yêu cầu chọn spline cần chia

+Chọn spline (xem lưu ý bên dưới)

- Lisp yêu cầu nhập khoảng cách giữa các đỉnh

+Nhập số giá trị độ dài các đỉnh (ví dụ: 1750 như file đính kèm)

- Lisp sẽ tự động chuyển spline gốc thành polyline theo yêu cầu như hình minh họa bên dưới

 

Lưu ý:

Điểm bắt đầu chia spline có thể xác định bởi vị trí chuột chọn vào đường spline đó:

Ví dụ: nếu điểm chọn spline gần điểm A thì nó bắt đầu chia đường 1750 từ A cho đến B (phần thừa sẽ ở phía Điểm B và ngược lại).

 

1969_spline_to_polyline_1.jpg

 

File cad minh họa

http://www.cadviet.com/upfiles/7/1969_spline_to_polyline.dwg

 

Trân trọng cảm ơn!

Bạn chạy thử 

 

(defun Tue-list-tach (lst count / i j Lst-tinh Reslis)
 ;;;;;Ex: (Tue-list-tach '(1 5 4 6 3 5) 2)--> ((1 5) (4 6) (3 5))
 ;;;;;;;;;(Tue-list-tach '(1 5 4 6 3 5) 3)--> ((1 5 4) (6 3 5))
 ;;;;;;;;;(Tue-list-tach '(1 5 4 6 3 5) 5)--> nil
   (setq i 0 j 0)
   (while (and (< i (/ (length lst) count)) (= (rem (length lst) count) 0))
(Repeat count
 (setq Lst-tinh (append Lst-tinh (list (nth j lst)) ))
 (setq j (1+ j))  
)
         (setq Reslis (append Reslis (list Lst-tinh))
      Lst-tinh nil)
     (setq i (1+ i))
    )
 Reslis
)
(defun Tue-make-Circle (lst / tam R _col _Lay _lstphu);;;Tue-make-Layer
;;;ex: (Tue-make-Circle (list (getpoint "\nNhap tam Circle:") (getdist "Nhap R :") ) )
;;;;;;;(Tue-make-Circle (list (getpoint "\nNhap tam Circle:") (getdist "Nhap R :") 1 ) )
;;;;;;;(Tue-make-Circle (list (getpoint "\nNhap tam Circle:") (getdist "Nhap R :") 1 "LAY") )
(mapcar 'set '(tam R _col _Lay _lstphu) lst)
(entmakex(append 
    (list '(0 . "Circle")  
  (cons 10 tam) 
  (cons 40 R) 
    )
    (if _col (list (cons 62 _col)) )
    (if _Lay
(if (tblsearch "Layer" _Lay) 
  (list (cons 8  _Lay)) 
  (list (cons 8 (Tue-make-Layer _Lay _col)))
)
    )
   _lstphu
)
)
)
(defun Tue-geom-inters(e1 e2 flag / Lst_tong Lst);;;Tue-list-tach
 ;;; flag= 0 : acExtendNone Does not extend either object.
 ;;; flag= 1 : acExtendThisEntity Extends the base object.
 ;;; flag= 2 : acExtendOtherEntity Extends the object passed as an argument.
 ;;; flag= 3 : acExtendBoth  Extends both objects.
 
;;Ex: (Tue-geom-inters (ssname (TUE-SS-ENTSEL '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")) "\npick chon doi tuong thu 1 :") 0)
;;;;;;(ssname (TUE-SS-ENTSEL '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")) "\npick chon doi tuong thu 2 :") 0) 0)
  (if (= (type e1) 'ENAME) (setq e1 (vlax-ename->vla-object e1)))
  (if (= (type e2) 'ENAME) (setq e2 (vlax-ename->vla-object e2)))
  (Tue-list-tach (vlax-invoke e1 'IntersectWith e2 flag) 3)
)
(defun Tue-make-LWPLINE(lst-pt layer)
(entmakex
  (apply 'append 
   (cons
     (list
'(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length lst-pt))
(cons 8 Layer)
'(70 . 0)
)
     (mapcar 'list (mapcar (function (lambda (a) (cons 10 a))) lst-pt) ) ;_ mapcar
     ) ;_ cons
  ) ;_ apply
)
)
(DEFUN C:CHIAspl()
  (SETQ spl (car(entsel "\nChon Spline can chia :")))
  (setq diemchia (getpoint "\nDiem bat dau chia :"))
  (setq kchia (getdist "\nKhoang chia :"))
  (if (< (distance diemchia (vlax-curve-getStartPoint spl)) (distance diemchia (vlax-curve-getendPoint spl)))
     (setq diemchia (vlax-curve-getStartPoint spl) HUONG T dss (vlax-curve-getendPoint spl))
     (setq diemchia (vlax-curve-getendPoint spl) HUONG NIL dss (vlax-curve-getStartPoint spl))
   )
   (setq lst-diem (list diemchia ))
  
  (while (<= kchia (distance diemchia dss))
       (setq circle (Tue-make-Circle (list diemchia kchia ) ))
       (SETQ GIAODIEM (Tue-geom-inters circle spl 0))
       (setq diemchia1 (car GIAODIEM)) (setq diemchia2 (caDr GIAODIEM))
       (IF (= (LENGTH giaodiem) 1)  (setq diemchia (car giaodiem))
(progn
            (IF HUONG (IF (> (VLAX-CURVE-GETPARAMATPOINT SPL diemchia1) (VLAX-CURVE-GETPARAMATPOINT SPL diemchia2))
(setq diemchia diemchia1) (setq diemchia diemchia2)
      )
(IF (> (VLAX-CURVE-GETPARAMATPOINT SPL diemchia1) (VLAX-CURVE-GETPARAMATPOINT SPL diemchia2))
(setq diemchia diemchia2) (setq diemchia diemchia1)
      )
   )
 )
     )
(entdel circle) (setq lst-diem (append lst-diem (list diemchia )))
       
  )
(Tue-make-LWPLINE (append lst-diem (list dss)) "0")
 
 
 
 )
  • Vote tăng 2

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  

×