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

[conghoa 125]

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).

 

 

File cad minh họa

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

 

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

[Tue_NV 3912]

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).

 

 

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")
 
 
 
 )

[conghoa 125]

Thanks bác Tue_NV, em đã dùng được rồi!

[tinhcatn 1]

-- bác ơi em load lisp thì nó hiện lỗi 

(LOAD "C:/Users/Administrator/Downloads/chiaspl.lsp") ; error: syntax 
error

 

-- là bị làm sao vậy bác