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

[Nhờ giúp đỡ] Ý tưởng convert spline ít điểm hơn.

Bởi tannguyen291 , trong AutoLisp

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

tannguyen291    163

tannguyen291
Đã đăng

Chào anh em. dạo này em đang viết một chương trình boundary hatch.

Vì muốn đường boundary là một polyline close nên buộc phải convert elipse, spline thành polyline.

Có một vấn đề em mắc phải là khi convert thì nhiều điểm thì nặng, ít điểm thì độ chính xác không cao.

em không muốn dùng command trong lisp

Các bác gợi ý cho em về một thuật toán giản lược điểm tại các đoạn có độ cong ít với ạ:

image.thumb.png.e0372ea088885c366d729ea22c53565e.png

 

xin phép gửi kèm đoạn code đang viết ạ. 

(defun ObjToLstPointBugle (obj / lenobj space lst i0 i1 i3 i2 i )
  (setq 
    lenobj (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
    space (if (< lenobj 25) 0.5 (/ lenobj 50))
    i 0 
  )
  (repeat (1+ (fix (/ lenobj space)))
    (setq i0 (vlax-curve-getpointatdist obj i))
    (cond
      ( (= i 0)
        (setq 
          i1 (vlax-curve-getpointatdist obj (+ i space 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i space -1e-4))
          i2 (vlax-curve-getpointatdist obj (+ i space))
          ang (- (angle i1 i3) (angle i2 i0))
        )
      )
      ( (> (+ i space) lenobj)
        (setq 
          i1 (vlax-curve-getpointatdist obj (- i 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i 1e-4))
          i2 (vlax-curve-getendpoint obj)
          ang (-  (angle i0 i2) (angle i1 i3))
        )
      )
      (t 
        (setq 
          i1 (vlax-curve-getpointatdist obj (- i 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i 1e-4))
          i2 (vlax-curve-getpointatdist obj (+ i space))
          ang (- (angle i0 i2) (angle i1 i3) )
        )
      )
    )
    (setq 
      i (+ i space)
      ang (/ (sin ang) (cos ang) 2)
      lst (append lst (list (list 10 (car i0) (cadr i0)) (cons 42 ang)))
    )
  )
  (vla-delete obj)
  lst
)

 

 

 

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

Doan Van Ha    3208

Doan Van Ha
Đã đăng

Nàng Lê Thị Mác có lisp lấy điểm dày/thưa theo độ cong.

;;----------------=={ Entity to Point List }==----------------;;
;;  Returns a list of points describing or approximating the supplied entity, else nil if the entity is not supported. ;;
;;  Author: Lee Mac, Copyright © 2011 - www.lee-mac.com       ;;
;;  Arguments:                                                ;;
;;  ent - Entity for which to return Point List.              ;;
;;  Returns:  List of Points describing/approximating entity  ;;
(defun LM:Entity->PointList(ent / der di1 di2 di3 elst fun inc lst par rad)
 (setq elst (entget ent))
 (cond
  ((member (cdr (assoc 0 elst)) '("CIRCLE" "ARC"))
   (setq di1 0.0 di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi)))))) fun (if (vlax-curve-isclosed ent) < <=))
   (while (fun di1 di2) (setq lst (cons (vlax-curve-getpointatdist ent di1) lst) di1 (+ di1 inc)))
    lst)
  ((eq (cdr (assoc 0 elst)) "ELLIPSE")
   (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent)) di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam   ent)) di3 (* di2 (/ (+ pi pi) (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent))))))
   (while (< di1 di2) (setq lst (cons (vlax-curve-getpointatdist ent di1) lst) der (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1))) di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))))
   (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)))
  ((or (eq (cdr (assoc 0 elst)) "LWPOLYLINE") (and (eq (cdr (assoc 0 elst)) "POLYLINE") (zerop (logand (cdr (assoc 70 elst)) 80))))
   (setq par 0)
   (repeat (fix (1+ (vlax-curve-getendparam ent)))
    (if (setq der (vlax-curve-getsecondderiv ent par))
     (if (equal der '(0.0 0.0 0.0) 1e-8)
      (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
      (if (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par)) di1 (vlax-curve-getdistatparam ent par) di2 (vlax-curve-getdistatparam ent (1+ par)))
       (progn
        (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
        (while (< di1 di2) (setq lst (cons (vlax-curve-getpointatdist ent di1) lst) di1 (+ di1 inc)))))))
    (setq par (1+ par)))
   (if (or (vlax-curve-isclosed ent) (equal '(0.0 0.0 0.0) der 1e-8)) lst (cons (vlax-curve-getendpoint ent) lst)))
  ((eq (cdr (assoc 0 elst)) "SPLINE") ; phô thuéc ®é cong
   (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent)) di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent)) inc (/ di2 25.0))
   (while (< di1 di2)
    (setq lst (cons (vlax-curve-getpointatdist ent di1) lst) der (/ (distance '(0.0 0.0) (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1))) inc)
                di1 (+ di1 (if (equal 0.0 der 1e-10) inc (min inc (/ 1.0 der (* 10. inc)))))))        ; chia theo ®é cong lín nhá (®é cong cµng lín ®iÓm chia cµng dµy).
            ; di1 (+ di1 inc)))                                                            ; chia theo kho¶ng c¸ch b»ng nhau.
  (if (vlax-curve-isclosed ent) lst (cons (vlax-curve-getendpoint ent) lst)))))

  • Vote tăng 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

tannguyen291    163

tannguyen291
Đã đăng
34 phút trước, Doan Van Ha đã nói:

Nàng Lê Thị Mác có lisp lấy điểm dày/thưa theo độ cong.

ui cảm ơn bác nha. để em nghiên cứu rồi đưa vào lisp ạ.

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

DuongTrungHuy    138

DuongTrungHuy
Đã đăng

Chào nhé.

sau khi chuyển về poly với điểm dày bạn có thể làm cứng poly cho ít đỉnh hơn theo ý tưởng nếu góc giữa 2 cạnh liền nhau lớn hơn 170 độ ( cái này tuỳ ý) thì bỏ đỉnh đó đi.

Bye 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

tannguyen291    163

tannguyen291
Đã đăng

 

image.thumb.png.cfb8da035f856492c0a9c6903c3f92c6.png

cảm ơn 2 đại hiệp trợ giúp

em tạo ra pline cong nên cũng không bị cứng đâu ạ 

Thân tặng anh em 1 hàm lấy tọa độ và độ phình theo đường cong 2d ạ 

(defun ObjToLstPointBugle (obj / lenobj space lst i0 i1 i3 i2 i ck1 ck2)
  (setq 
    lenobj (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj))
    space (/ (vla-get-area obj) lenobj 20) i 0)
  (while (< i lenobj)
    (setq i0 (vlax-curve-getpointatdist obj i) ang 0 ck1 t ck2 0 )
    (while (and 
             (< i lenobj)
             (equal ck2 0 0.02)
             ck1
           )
      (setq i (+ i space))
      (if (> i lenobj)
        (setq 
          i2 (vlax-curve-getdistatpoint obj i0)
          i1 (vlax-curve-getpointatdist obj (- i2 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i2 1e-4))
          i2 (vlax-curve-getendpoint obj)
          ck2 (- (angle i0 i2) (angle i1 i3))
        )
        (setq 
          i1 (vlax-curve-getpointatdist obj (+ i 1e-4))
          i3 (vlax-curve-getpointatdist obj (+ i -1e-4))
          i2 (vlax-curve-getpointatdist obj i)
          ck2 (- (angle i1 i3) (angle i2 i0))
        )
      )
      (setq ck2 (/ (sin ck2) (cos ck2) 2))
      (if (< (* ck2 ang) 0)
        (setq 
          i (- i space )
          ck1 nil
        )
        (setq ang ck2)
      )
    )
    (setq lst (append lst (list (list 10 (car i0) (cadr i0)) (cons 42 ang))))
  )
  (setq i0 (vlax-curve-getendpoint obj))
  (append lst (list (list 10 (car i0) (cadr i0))) )
)

Đây là hàm test ạ

  

(defun c:CurveToPlineBugle (/ ss i lst object numvetex)
  (setq ss (ssget '((0 . "ELLIPSE,SPLINE"))))
  (repeat (setq i (sslength ss))
    (setq 
      i (1- i)
      object (vlax-ename->vla-object (ssname ss i))
      lst (ObjToLstPointBugle object)
      numvetex (cons 90 (apply '+ (mapcar '(lambda (x) (if (= 10 (car x)) 1 0)) lst)))
    )
    (vla-delete object)
    (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") numvetex) lst))
  )
  (princ)
)

 

 

  • Like 1
  • Vote tăng 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

7o7    84

7o7
Đã đăng

Bác nghĩ ra hàm như vậy cũng rất hay, nhưng tôi thấy xài lệnh SPLINEDIT với precision 10 cũng ra kết quả tương tự.

Tôi nghĩ bác nên viết cho pline thì hay hơn cho spline.

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

tannguyen291    163

tannguyen291
Đã đăng
10 giờ trước, 7o7 đã nói:

Bác nghĩ ra hàm như vậy cũng rất hay, nhưng tôi thấy xài lệnh SPLINEDIT với precision 10 cũng ra kết quả tương tự.

 Tôi nghĩ bác nên viết cho pline thì hay hơn cho spline.

Tại em đang viết hàm boundary hatch và hàm convert này là 1 hàm con trong lisp nên không muốn dùng command.

ngoài ra Lệnh SPLINEDIT không có độ phình (arc bulge) nên đường cong không mượt. 

image.thumb.png.6437340079fe99c6c3e6aa3393188536.png

  • 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

QUYDO369    0

QUYDO369
Đã đăng
Vào lúc 29/3/2023 tại 08:13, tannguyen291 đã nói:

Tại em đang viết hàm boundary hatch và hàm convert này là 1 hàm con trong lisp nên không muốn dùng command.

ngoài ra Lệnh SPLINEDIT không có độ phình (arc bulge) nên đường cong không mượt. 

image.thumb.png.6437340079fe99c6c3e6aa3393188536.png

cho mình xin lisp và cách dùng lisp này 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

tannguyen291    163

tannguyen291
Đã đăng
Vào lúc 28/3/2023 tại 14:42, tannguyen291 đã nói:

(defun ObjToLstPointBugle (obj / lenobj space lst i0 i1 i3 i2 i ck1 ck2) (setq lenobj (vlax-curve-getdistatparam obj (vlax-curve-getendparam obj)) space (/ (vla-get-area obj) lenobj 20) i 0) (while (< i lenobj) (setq i0 (vlax-curve-getpointatdist obj i) ang 0 ck1 t ck2 0 ) (while (and (< i lenobj) (equal ck2 0 0.02) ck1 ) (setq i (+ i space)) (if (> i lenobj) (setq i2 (vlax-curve-getdistatpoint obj i0) i1 (vlax-curve-getpointatdist obj (- i2 1e-4)) i3 (vlax-curve-getpointatdist obj (+ i2 1e-4)) i2 (vlax-curve-getendpoint obj) ck2 (- (angle i0 i2) (angle i1 i3)) ) (setq i1 (vlax-curve-getpointatdist obj (+ i 1e-4)) i3 (vlax-curve-getpointatdist obj (+ i -1e-4)) i2 (vlax-curve-getpointatdist obj i) ck2 (- (angle i1 i3) (angle i2 i0)) ) ) (setq ck2 (/ (sin ck2) (cos ck2) 2)) (if (< (* ck2 ang) 0) (setq i (- i space ) ck1 nil ) (setq ang ck2) ) ) (setq lst (append lst (list (list 10 (car i0) (cadr i0)) (cons 42 ang)))) ) (setq i0 (vlax-curve-getendpoint obj)) (append lst (list (list 10 (car i0) (cadr i0))) ) )

 

Vào lúc 28/3/2023 tại 14:42, tannguyen291 đã nói:

(defun c:CurveToPlineBugle (/ ss i lst object numvetex) (setq ss (ssget '((0 . "ELLIPSE,SPLINE")))) (repeat (setq i (sslength ss)) (setq i (1- i) object (vlax-ename->vla-object (ssname ss i)) lst (ObjToLstPointBugle object) numvetex (cons 90 (apply '+ (mapcar '(lambda (x) (if (= 10 (car x)) 1 0)) lst))) ) (vla-delete object) (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") numvetex) lst)) ) (princ) )

 

17 giờ trước, QUYDO369 đã nói:

cho mình xin lisp và cách dùng lisp này với ạ

 

Bạn coppy 2 lisp trên vào 1 file là chạy được lisp nhé

lệnh CurveToPlineBugle

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

Lee123    0

Lee123
Đã đăng

lips bác này chỉ chạy được các đường spline đơn giản thôi, các đường phúc tạp thì nó xoay đến mùa quýt luôn.

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

tannguyen291    163

tannguyen291
Đã đăng
9 giờ trước, Lee123 đã nói:

lips bác này chỉ chạy được các đường spline đơn giản thôi, các đường phúc tạp thì nó xoay đến mùa quýt luôn.

Lisp của mình là ước tính. nên độ chính xác không cao. :)) ngoài ra nếu bạn biết về lisp thì có thể sửa variable space và giá trị so sánh bulge tại dòng 2 và dòng 9 để phù hợp với nhu cầu. (đây là giá trị đánh giá từng bước. càng nhỏ càng lâu càng chính xác, càng lớn các nhanh càng thiếu chính xác). như vậy sẽ đáp ứng được công việc của bạn.

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

cuongtk2    415

cuongtk2
Đã đăng

@tannguyen291 Em phát biểu đúng về việc chia càng nhiều khoảng thì càng chính xác. Nhưng về bản chất  spline và pline khác nhau về độ bẻ cong tại node, một bên là knode, một bên là bulge. Cho nên việc chia đều khoảng cách spline với 20 điểm có thể không chính xác bằng chia không đều với 5 điểm.

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

tannguyen291    163

tannguyen291
Đã đăng
6 phút trước, cuongtk2 đã nói:

@tannguyen291 Em phát biểu đúng về việc chia càng nhiều khoảng thì càng chính xác. Nhưng về bản chất  spline và pline khác nhau về độ bẻ cong tại node, một bên là knode, một bên là bulge. Cho nên việc chia đều khoảng cách spline với 20 điểm có thể không chính xác bằng chia không đều với 5 điểm.

Lisp của em là chia không đều mà. space này chỉ đơn giản là timming để dò tìm thôi. :)) quan trọng còn có dòng này nữa: (equal ck2 0 0.02) tính toán gần đúng cho bulge. giảm xuống mới tạo ra nhiều điểm hơn.

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

cuongtk2    415

cuongtk2
Đã đăng

@tannguyen291 Em làm rất đúng. Tặng em 1 hàm có thể có íchc 

(defun CurveGetAngleAtDist (object dist / param VEC X Y)
(setq param (vlax-curve-getParamAtDist object dist)
   vec (vlax-curve-getFirstDeriv object param)
      x (nth 0 vec)
      y (nth 1 vec))
(if (/= x 0) (atan (/ y x)) (if (> y 0) (* PI 0.5)(* PI -0.5) )
  )
  )

 

  • 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

tannguyen291    163

tannguyen291
Đã đăng
9 phút trước, cuongtk2 đã nói:

@tannguyen291 Em làm rất đúng. Tặng em 1 hàm có thể có íchc 


(defun CurveGetAngleAtDist (object dist / param VEC X Y)
(setq param (vlax-curve-getParamAtDist object dist)
   vec (vlax-curve-getFirstDeriv object param)
      x (nth 0 vec)
      y (nth 1 vec))
(if (/= x 0) (atan (/ y x)) (if (> y 0) (* PI 0.5)(* PI -0.5) )
  )
  )

 

Tks bác. hàm này có thể giảm thiểu một số tính toán thừa của em. 

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
×