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

[tannguyen291 55]

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 ạ:

 

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
)

 

 

 

[Doan Van Ha 3.122]

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

[tannguyen291 55]

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

[DuongTrungHuy 126]

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

 

[tannguyen291 55]

 

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

 

 

[7o7 61]

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.

[tannguyen291 55]

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.