Đến nội dung


Hình ảnh
- - - - -

Xóa bớt đỉnh


  • Please log in to reply
29 replies to this topic

#1 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 06 January 2014 - 04:10 PM

Chào các bạn,

Mình có vấn đề như sau: Mình có 1 hình có các đỉnh được đánh số từ 0->7, các đỉnh 1,3,6 nằm rải rác trên các cạnh và cung tròn. mình có sử dụng hàm IsOn() để kiểm tra 2 đường thẳng trùng nhau. Nhưng mình thấy có vẻ không hiệu quả . Các bạn ai có cách xóa bớt các đỉnh 1,3,6 không giúp mình với. Mình xin chân thành cảm ơn. Và mình dùng .net để làm việc này.

 

125141_hh1_1.png

Sau khi xóa:

125141_hh2.png

 


  • 1

#2 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 06 January 2014 - 05:16 PM

Mong mọi người cố gắng giúp mình vấn đề này với. Có j ko rõ các bạn các thể comment để mình giải thích.


  • 0

#3 lamchivinh

lamchivinh

    biết zoom

  • Members
  • Pip
  • 11 Bài viết
Điểm đánh giá: 3 (bình thường)

Đã gửi 07 January 2014 - 10:12 AM

Vấn đề này khó nhai nhể. Để tìm hiểu kỹ xem có giúp được bạn không.


  • 0

#4 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6010 Bài viết
Điểm đánh giá: 3114 (tuyệt vời)

Đã gửi 07 January 2014 - 11:46 AM

Mong mọi người cố gắng giúp mình vấn đề này với. Có j ko rõ các bạn các thể comment để mình giải thích.

Hề hề hề,

Vấn đề của bạn chưa rõ ràng nên khó có câu trả lời chính xác.

1/- Cái hình của bạn được tạo bới pline hay là tổ hợp của cácline và cung tròn ???

2/- Các đỉnh này có khi tạo hình hay là các đỉnh đó được thêm vào cho ....oai sau khi đã có hình.

3/- Tiêu chí để xác dịnh các đỉnh cần bớt, là các đỉnh mang số hiệu xác định hay bớt sao tùy ý miễn là bớt đi 3 đỉnh????


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#5 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 07 January 2014 - 01:20 PM

Chào bạn  phamthanhbinh

Mình trả lời bạn như sau:

1/ Cái hình mình được tạo như sau:

125741_hhh1_1.png

Mình có đính kèm file autocad. Hình này được tạo từ các line và cung tròn.(Lưu ý: Hình trên mình chỉ ví dụ thôi)

http://www.cadviet.c...41_drawing4.dwg

 

2/Các đỉnh có trong lúc tạo hình.

3/Xoá bớt các đỉnh thừa. Chỉ dữ lại các đỉnh có các cạnh cắt nhau. Ví dụ như hình trên. có 3 đỉnh (0,1,2) bạn thấy đỉnh 1 nằm ở giữa 2 đỉnh 0 và 2. Giờ mình muốn xoá đỉnh này thì làm sao. Tương tự mình muốn xoá các đỉnh các đỉnh 3,5,8.  Cảm ơn các bạn đã quan tâm


  • 0

#6 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6010 Bài viết
Điểm đánh giá: 3114 (tuyệt vời)

Đã gửi 07 January 2014 - 03:07 PM

Chào bạn  phamthanhbinh

Mình trả lời bạn như sau:

1/ Cái hình mình được tạo như sau:

125741_hhh1_1.png

Mình có đính kèm file autocad. Hình này được tạo từ các line và cung tròn.(Lưu ý: Hình trên mình chỉ ví dụ thôi)

http://www.cadviet.c...41_drawing4.dwg

 

2/Các đỉnh có trong lúc tạo hình.

3/Xoá bớt các đỉnh thừa. Chỉ dữ lại các đỉnh có các cạnh cắt nhau. Ví dụ như hình trên. có 3 đỉnh (0,1,2) bạn thấy đỉnh 1 nằm ở giữa 2 đỉnh 0 và 2. Giờ mình muốn xoá đỉnh này thì làm sao. Tương tự mình muốn xoá các đỉnh các đỉnh 3,5,8.  Cảm ơn các bạn đã quan tâm

Hề hề hề,

1/- Căn cứ vào bản vẽ bạn gửi thì hình của bạn được tạo bởi Lwpolyline chứ không phải là các line và arc như bạn nói.

2/- Nếu đúng các hình cũa bạn đều có dạng tương tự như hình bạn gửi thì có thể có cách để xóa các đỉnh như bạn yêu cầu. 

cách làm có thể như sau:

- lấy danh sách các đỉnh của lwpolyline.

- Kiểm tra vecto tiếp tuyến tại mỗi đỉnh, nếu vécto này trùng với vecto tiếp tuyến tại đỉnh trước nó thì loại điểm đó khỏi danh sách đỉnh.

- Kiểm tra giá trị bulge tại mỗi đỉnh, nếu giá trị này trùng với giá trị tại đỉnh trước đó thì loai đỉnh đó ra khỏi danh sách các đỉnh.

- tạo lại lwpolyline từ danh sách các đỉnh và giá trị bulge tương ứng.

- xóa bỏ lwpolyline cũ.

3/- Đây chỉ là một trong các cách bạn có thể áp dụng, Có thể nó chưa hay nhưng may ra nó đáp ứng được yêu cầu của bạn. Hãy thử làm xem sao.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#7 Polyline

Polyline

    biết lệnh mirror

  • Members
  • PipPipPip
  • 159 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 07 January 2014 - 04:05 PM

Theo mình hiểu, chủ thớt muốn xóa các điểm thừa trong PLine, nghĩa là xóa những điểm mà không có nó thì đặc tính của PLine (chiều dài, diện tích, ...) không thay đổi.

Kiểm tra vecto tiếp tuyến chỉ xử lý được cho các đoạn thẳng, còn các cung tròn thì sao? Ví dụ như điểm số 5.


  • 1

#8 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 417 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 07 January 2014 - 04:19 PM

;;;=======================[ PSimple.lsp ]======================= 
;;; Author: Charles Alan Butler 
;;; Version:  1.7 Nov. 24, 2007
;;; Purpose: To remove unnecessary vertex from a pline
;;; Supports arcs and varying widths
;;;=============================================================
;; This version will remove the first vertex if it is colinear
;; and first & last arcs that have the same center

;;  command line entry, user selection set pick
(defun c:PSimple () (PSimpleUser nil)(princ))
(defun c:PSimpleV () ; Verbose version
  (mapcar '(lambda(x)(print (car x))(princ (cadr x))) (PSimpleUser nil))
  (princ)
)

;;  User interface Function
;;  flag = nil -> user selects a selection set
;;       = ENAME -> call the routine
;;       = OBJECT -> call the routine
;;       = True   -> User to select a single entity, repeats
(defun PSimpleUser (flag / ss ent)
  (cond
    ((null flag)    ; user selection set pick
     (prompt "\n Select polylines to remove extra vertex: ")
     (if (setq ss (ssget '((0 . "LWPOLYLINE"))))
       (PSimple ss)
     )
    )
    ;;  next two already have an object so pass to the main routine
    ((= (type flag) 'ENAME) (PSimple flag))
    ((= (type flag) 'VLA-object) (PSimple flag))
    (t  ; user single pick with repeat
       (while
         (setq ent (car (entsel "\n Select polyline to remove extra vertex: ")))
          (if (equal (assoc 0 (entget ent)) '(0 . "LWPOLYLINE"))
            (PSimple ent)
            (prompt "\nNot a LWPolyline, Try again.")
          )
       )
    )
  )
)





;;;=======================[ PSimple.lsp ]======================= 
;;; Author: Charles Alan Butler 
;;; Version:  1.7 Nov. 23, 2007
;;; Purpose: To remove unnecessary vertex from a pline
;;; Supports arcs and varying widths
;;;=============================================================
;; This version will remove the first vertex if it is colinear
;; and first & last arcs that have the same center
;; Open plines that have the same start & end point will be closed

;;  Argument: et
;;    may be an ename, Vla-Object, list of enames or
;;    a selection set
;;  Returns: a list, (ename message)
;;    Massage is number of vertex removed or error message string
;;    If a list or selection set a list of lists is returned
(defun PSimple (et / doc result Tan Replace BulgeCenter RemoveNlst ps1)
  (vl-load-com)

  (defun tan (a) (/ (sin a) (cos a)))

  (defun replace (lst i itm)
    (setq i (1+ i))
    (mapcar '(lambda (x) (if (zerop (setq i (1- i))) itm x)) lst)
  )

  
  ;;  CAB 11.16.07
  ;;  Remove based on pointer list
  (defun RemoveNlst (nlst lst)
    (setq i -1)
    (vl-remove-if  '(lambda (x) (not (null (vl-position (setq i (1+ i)) nlst)))) lst)
  )
  
  (defun BulgeCenter (bulge p1 p2 / delta chord radius center)
    (setq delta  (* (atan bulge) 4)
          chord  (distance p1 p2)
          radius (/ chord (sin (/ delta 2)) 2)
          center (polar p1 (+ (angle p1 p2) (/ (- pi delta) 2)) radius)
    )
  )

  ;;  Main function to remove vertex
  ;;  ent must be an ename of a LWPolyline
  (defun ps1 (ent /      aa     cpt    dir    doc    elst   hlst   Remove
                  idx    keep   len    newb   result vlst   x      closed
                  d10    d40    d41    d42    hlst   p1     p2     p3
                  plast  msg)
      ;;=====================================================
      (setq elst (entget ent)
            msg  "")
      (setq d10 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) elst)))
      (if (> (length d10) 2)
        (progn
          ;;  seperate vertex data
          (setq d40 (vl-remove-if-not '(lambda (x) (= (car x) 40)) elst))
          (setq d41 (vl-remove-if-not '(lambda (x) (= (car x) 41)) elst))
          (setq d42 (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 42)) elst)))
          ;;  remove extra vertex from point list
          (setq plast (1- (length d10)))
          (setq p1 0  p2 1  p3 2)
          (if (and (not (setq closed (vlax-curve-isclosed ent)))
                   (equal (car d10) (last d10) 1e-6))
            (progn
              (setq Closed t ; close the pline
                    elst (subst (cons 70 (1+(cdr(assoc 70 elst))))(assoc 70 elst) elst)
                    msg  " Closed and")
              (if (and (not(zerop (nth plast d42)))(not(zerop (nth 0 d42))))
                (setq d10 (reverse(cdr(reverse d10)))
                      d40 (reverse(cdr(reverse d40)))
                      d41 (reverse(cdr(reverse d41)))
                      d42 (reverse(cdr(reverse d42)))
                      plast (1- plast)
                )
              )
            )
          )
          (setq idx -1)
          (while (<= (setq idx (1+ idx)) (if closed (+ plast 2) (- plast 2)))
            (cond
              ((and (or (equal (angle (nth p1 d10) (nth p2 d10))
                               (angle (nth p2 d10) (nth p3 d10)) 1e-6)
                        (equal (nth p1 d10) (nth p2 d10) 1e-6)
                        (equal (nth p2 d10) (nth p3 d10) 1e-6))
                    (zerop (nth p2 d42))
                    (or (= p1 plast)
                        (zerop (nth p1 d42)))
               )
               (setq remove (cons p2 remove)) ; build a pointer list
               (setq p2 (if (= p2 plast) 0 (1+ p2))
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
              ((and (not (zerop (nth p2 d42)))
                    (or closed (/= p1 plast))
                    (not (zerop (nth p1 d42))) ; got two arcs
                    (equal
                      (setq cpt (BulgeCenter (nth p1 d42) (nth p1 d10) (nth p2 d10)))
                      (BulgeCenter (nth p2 d42) (nth p2 d10) (nth p3 d10))
                      1e-4)
               )
               ;;  combine the arcs
               (setq aa   (+ (* 4 (atan (abs (nth p1 d42))))(* 4 (atan (abs (nth p2 d42)))))
                     newb (tan (/ aa 4.0))
               )
               (if (minusp (nth p1 d42))
                 (setq newb (- (abs newb)))
                 (setq newb (abs newb))
               )
               (setq remove (cons p2 remove)) ; build a pointer list
               (setq d42 (replace d42 p1 newb))
               (setq p2 (if (= p2 plast) 0 (1+ p2))
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
              (t
               (setq p1 p2
                     p2 (if (= p2 plast) 0 (1+ p2))
                     p3 (if (= p3 plast) 0 (1+ p3))
               )
              )
            )
          )
          (if remove
            (progn
              (setq count (length d10))
              ;; Rebuild the vertex data with pt, start & end width, bulge
              (setq d10 (RemoveNlst remove d10)
                    d40 (RemoveNlst remove d40)
                    d41 (RemoveNlst remove d41)
                    d42 (RemoveNlst remove d42)
              )
              (setq result (mapcar '(lambda(w x y z) (list(cons 10 w)
                                        x  y
                                        (cons 42 z))) d10 d40 d41 d42)
              )
              ;;  rebuild the entity data with new vertex data
              (setq hlst (vl-remove-if
                           '(lambda (x) (vl-position (car x) '(40 41 42 10))) elst)
              )
              (mapcar '(lambda (x) (setq hlst (append hlst x))) result)
              (setq hlst (subst (cons 90 (length result)) (assoc 90 hlst) hlst))
              (if (entmod hlst); return ename and number of vertex removed
                (list ent (strcat msg " Vertex removed " (itoa(- count (length d10)))))
                (list ent " Error, may be on locked layer.")
              )
            )
            (list ent "Nothing to remove - no colenier vertex.")
          )
        )
        (list ent "Nothing to do - Only two vertex.")
      )
    )
  

  ;;  ========  S T A R T   H E R E  ===========
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (cond
    ((or (=(type et) 'ENAME)
         (and (=(type et) 'VLA-object)
              (setq et (vlax-vla-object->ename et))))
      (vla-startundomark doc)
      (setq result (ps1 et))
      (vla-endundomark doc)
     )
    ((= (type et) 'PICKSET)
      (vla-startundomark doc)
      (setq result (mapcar '(lambda(x) (ps1 x))
              (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
      (vla-endundomark doc)
    )
    ((listp et)
      (vla-startundomark doc)
      (setq result (mapcar '(lambda(x) (ps1 x)) et))
      (vla-endundomark doc)
    )
    ((setq result "PSimple Error - Wrong Data Type."))
  )
  result
)
(prompt "\nPline Simplify loaded, PSimple to run.")
(princ)

Mình tìm thấy cái này làm đúng theo yêu cầu của bạn.

Tên lệnh: PSimple


  • 1

#9 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 07 January 2014 - 04:31 PM

Ý của mình giống như bạn phamthanhbinh nói.


  • 0

#10 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6010 Bài viết
Điểm đánh giá: 3114 (tuyệt vời)

Đã gửi 08 January 2014 - 12:16 PM

Ý của mình giống như bạn phamthanhbinh nói.

Hề hề hề,

Đây là lisp mình làm thử theo giải pháp mình đã đề xuất bên trên. Tuy nhiên có khác chút chút ở bước kiểm tra giá trị bulge. do các cung có cùng bán kính và cùng tâm vẫn có các giá trị bulge khác nhau, Vì thế việc kiểm tra ở trong líp này chỉ đảm bảo là nếu có hai cung cong liên tiếp thì điểm nối sẽ bị loại trừ và thay cả hai cung này bằng một cung khác. Do đó khi sử dụng phải lưu ý điều này và phải kiểm tra trước xem các cung này có thực sự cùng tâm và bán kinh hay không. Nếu không thì việc thay thế như trên có hợp với yêu cầu hay không???

Vì mình chỉ căn cứ vào bản vẽ bạn đã gửi để viết lisp nên nếu như các hình khác của bạn không có các đặc tinh tương tự với bản vẽ bạn gửi thì không đảm bảo lisp sẽ chạy đúng yêu cầu. Tỷ như trường hợp  hình của bạn không phải là một lwpolyline kín hay là tổ hợp của các lines và các ảc rời rạc hoặc có nhiều cung bán kính khác nhau nối tiếp nhau .....

Mình đã chạy thử lisp với hình vẻ bạn gửi thì mọi thứ đều tốt.

Hãy dùng thử và cho ý kiến nếu thấy cần sửa chữa hay bổ sung.

http://www.cadviet.c...oadinhpline.lsp

 

(defun c:xdpl (/ pl oldos plst plst1 plob elst bulst vtt1 vtt2 bul1 bul2 ang1 ang2 i k k1 b1 b2 sp m col)

(vl-load-com)

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

(command "undo" "be")

(setq pl (car (entsel "\n chon pline can xoa bot cac dinh"))

         plst (acet-geom-vertex-list pl)

         plob (vlax-ename->vla-object pl)

         elst (entget pl)

         bulst (list)

         plst1 plst

)

(if  (assoc 62 elst)

     (setq col (rtos (cdr (assoc 62 elst)) 2 0))

     (setq col "256")

)

(alert (strcat "\n Doi tuong co ma mau la : " col))

(setq m (getstring "\n Nhap ma mau khac voi ma mau hien tai cua doi tuong: "))

(if (= m "") (setq m "256"))

(command "cecolor" m)

(foreach a elst

        (if (= (car a) 42)

            (setq bulst (append bulst (list (cdr a))))

        )

)

(foreach vrt plst

       (setq i (vl-position vrt plst))

       (if (> i 0)

           (progn

                 (setq vtt1 (vlax-curve-getFirstDeriv plob (vlax-curve-getParamAtPoint plob (nth (1- i) plst))) ) 

                 (setq vtt2 (vlax-curve-getFirstDeriv plob (vlax-curve-getParamAtPoint plob vrt)) )

                 (setq bul1 (nth (1- i) bulst)

                           bul2 (nth i bulst)   )

                 (setq ang1 (angle '(0 0 0) vtt1)

                           ang2 (angle '(0 0 0) vtt2) )

                 (if (and (= bul1 0.0) (=  bul2 0.0) (equal ang1  ang2  0.0000001))

                     (setq plst1 (vl-remove vrt plst1))

                 )

                 (if (and (/= bul2 0.0) (/= bul1 0.0))

                      (setq plst1 (vl-remove vrt plst1) )

                 )

           )

        )

)

(setq plst1 (reverse (cdr (reverse plst1))))

(command "pline")

(foreach p plst1

    (setq k (vl-position p plst)

              b1 (nth k bulst) 

              k1 (vl-position p plst1) 

    )

    (if (> k1 0)

        (setq b2 (nth (vl-position (nth (1- k1) plst1) plst) bulst))

        (setq b2 0.0)

    )

    (if (= b1 0) 

        (if (= b2 0.0)

            (command p)

            (command p "l")

       )

        (progn

              (command p)

              (command "a" "s")

              (if (not (equal (nth (1+ k) plst) (nth (1+ k1) plst1) 0.0000001))

                  (setq sp  (nth (1+ k) plst)) 

                  (setq sp (getpoint "\n Chon diem thu hai thuoc cung tron"))

              )

              (command sp )  

          )

      )

)

(command "c")

(command "erase" pl "")

(command "undo" "e")

(setvar "osmode" oldos)

(princ)

)       

 


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#11 ndtnv

ndtnv

    biết lệnh divide

  • Members
  • PipPipPipPipPipPip
  • 440 Bài viết
Điểm đánh giá: 390 (khá)

Đã gửi 08 January 2014 - 01:10 PM

Hề hề hề,

Đây là lisp mình làm thử theo giải pháp mình đã đề xuất bên trên. Tuy nhiên có khác chút chút ở bước kiểm tra giá trị bulge. do các cung có cùng bán kính và cùng tâm vẫn có các giá trị bulge khác nhau, Vì thế việc kiểm tra ở trong líp này chỉ đảm bảo là nếu có hai cung cong liên tiếp thì điểm nối sẽ bị loại trừ và thay cả hai cung này bằng một cung khác. Do đó khi sử dụng phải lưu ý điều này và phải kiểm tra trước xem các cung này có thực sự cùng tâm và bán kinh hay không. Nếu không thì việc thay thế như trên có hợp với yêu cầu hay không???

Vì mình chỉ căn cứ vào bản vẽ bạn đã gửi để viết lisp nên nếu như các hình khác của bạn không có các đặc tinh tương tự với bản vẽ bạn gửi thì không đảm bảo lisp sẽ chạy đúng yêu cầu. Tỷ như trường hợp  hình của bạn không phải là một lwpolyline kín hay là tổ hợp của các lines và các ảc rời rạc hoặc có nhiều cung bán kính khác nhau nối tiếp nhau .....

Mình đã chạy thử lisp với hình vẻ bạn gửi thì mọi thứ đều tốt.

Hãy dùng thử và cho ý kiến nếu thấy cần sửa chữa hay bổ sung.

http://www.cadviet.c...oadinhpline.lsp

 

(defun c:xdpl (/ pl oldos plst plst1 plob elst bulst vtt1 vtt2 bul1 bul2 ang1 ang2 i k k1 b1 b2 sp m col)

(vl-load-com)

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

(command "undo" "be")

(setq pl (car (entsel "\n chon pline can xoa bot cac dinh"))

         plst (acet-geom-vertex-list pl)

         plob (vlax-ename->vla-object pl)

         elst (entget pl)

         bulst (list)

         plst1 plst

)

(if  (assoc 62 elst)

     (setq col (rtos (cdr (assoc 62 elst)) 2 0))

     (setq col "256")

)

(alert (strcat "\n Doi tuong co ma mau la : " col))

(setq m (getstring "\n Nhap ma mau khac voi ma mau hien tai cua doi tuong: "))

(if (= m "") (setq m "256"))

(command "cecolor" m)

(foreach a elst

        (if (= (car a) 42)

            (setq bulst (append bulst (list (cdr a))))

        )

)

(foreach vrt plst

       (setq i (vl-position vrt plst))

       (if (> i 0)

           (progn

                 (setq vtt1 (vlax-curve-getFirstDeriv plob (vlax-curve-getParamAtPoint plob (nth (1- i) plst))) ) 

                 (setq vtt2 (vlax-curve-getFirstDeriv plob (vlax-curve-getParamAtPoint plob vrt)) )

                 (setq bul1 (nth (1- i) bulst)

                           bul2 (nth i bulst)   )

                 (setq ang1 (angle '(0 0 0) vtt1)

                           ang2 (angle '(0 0 0) vtt2) )

                 (if (and (= bul1 0.0) (=  bul2 0.0) (equal ang1  ang2  0.0000001))

                     (setq plst1 (vl-remove vrt plst1))

                 )

                 (if (and (/= bul2 0.0) (/= bul1 0.0))

                      (setq plst1 (vl-remove vrt plst1) )

                 )

           )

        )

)

(setq plst1 (reverse (cdr (reverse plst1))))

(command "pline")

(foreach p plst1

    (setq k (vl-position p plst)

              b1 (nth k bulst) 

              k1 (vl-position p plst1) 

    )

    (if (> k1 0)

        (setq b2 (nth (vl-position (nth (1- k1) plst1) plst) bulst))

        (setq b2 0.0)

    )

    (if (= b1 0) 

        (if (= b2 0.0)

            (command p)

            (command p "l")

       )

        (progn

              (command p)

              (command "a" "s")

              (if (not (equal (nth (1+ k) plst) (nth (1+ k1) plst1) 0.0000001))

                  (setq sp  (nth (1+ k) plst)) 

                  (setq sp (getpoint "\n Chon diem thu hai thuoc cung tron"))

              )

              (command sp )  

          )

      )

)

(command "c")

(command "erase" pl "")

(command "undo" "e")

(setvar "osmode" oldos)

(princ)

)       

 

Cách tính hệ số Bulge như trong bài # 8 mới đúng. Code của bạn PTB test đúng chỉ là do 2 đoạn arc trong Pline có độ dài = nhau.


  • 1

#12 hoathuongphuoc

hoathuongphuoc

    biết lệnh erase

  • Members
  • PipPipPip
  • 102 Bài viết
Điểm đánh giá: 9 (bình thường)

Đã gửi 08 January 2014 - 01:11 PM

Mình thật sự cảm ơn bạn. Bạn cho mình hỏi 1 câu. cái lisp này có thể chuyển sang ngôn ngữ khác được không. Thanks.


  • 0

#13 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6010 Bài viết
Điểm đánh giá: 3114 (tuyệt vời)

Đã gửi 08 January 2014 - 02:05 PM

Mình thật sự cảm ơn bạn. Bạn cho mình hỏi 1 câu. cái lisp này có thể chuyển sang ngôn ngữ khác được không. Thanks.

Hề hề hề.

Theo mình hiểu thì hoàn toàn có thể chuyển được nếu như ngôn ngữ đó cho phép Cad đọc và dịch được nó. Tuy nhiên cách diễn đat của ngôn ngữ đó có thể không giống như trong lisp.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#14 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6010 Bài viết
Điểm đánh giá: 3114 (tuyệt vời)

Đã gửi 08 January 2014 - 02:39 PM

Cách tính hệ số Bulge như trong bài # 8 mới đúng. Code của bạn PTB test đúng chỉ là do 2 đoạn arc trong Pline có độ dài = nhau.

Hề hề hề,

Bác đã tét thử cái lisp của mình chưa ạ???

Thực ra như đã nói cái lisp của mình không kiểm tra và tính toán bán kính cung và tâm cung. Nó chỉ cần biết có hai cung nối tiếp nhau là xóa béng cái điểm nối này đi và tạo lại cung mới. Do vậy nếu hai cung cung này có cùng bán kinh và tâm như bản vẽ của chủ thớt thì nó sẽ trúng ý chủ thớt . (thực tế bản vẽ của chủ thớt thì hai cung này chỉ gần bằng nhau chứ không hoàn toàn bằng nhau đâu ạ) 

Trường hợp hai cung này không phải hai cung đồng tâm và bán kính thì cái lisp này sẽ vẽ lại một cung mới đi qua ba điểm mút của hai cung nối tiếp nhau chứ không trùng với bất cứ cung nào trong số hai cung nối tiếp này.

Trường hợp nếu có nhiều cung nối tiếp thì lisp sẽ xóa tất cả các điểm nối tiếp trung gian và tạo lại một cung đi qua ba điểm là đểm đầu và cuối của cung đầu tiên và điểm chót của cung cuối cùng.

Do vậy nếu có nhiều cung nối tiếp mà đều cùng tâm và bán kính thì lisp vẫn tạo được một cung trùng với tất cả các cung tạo ra đoạn cung pline đó.

Và có nhẽ chủ thớt cũng chỉ cần tới điều này.

Việc xác định tâm và bán kinh của cung khi biết giá trị bulge của cung và hai điểm giới hạn cung không phải là quá phức tạp, nhưng nó sẽ hơi loằng ngoằng khi vẽ lại các cung pline theo cách vẽ arc-center- endpoint.

Cũng chính lý do này nên mình chọn vẽ cung pline theo startpoint-second point-endpoint để khỏi phải xác định tâm và bán kính cung.chỉ cần dựa vào các point của cung có trước là OK. Để người dùng có thể xác định dược vị trí vẽ mình đã chơi kiểu đổi màu nét vẽ cho dễ nhòm.

Bác có thể xem kỹ lại code của mình và góp thêm ý kiến để giải quyết vấn đề triệt để hơn.

Xin chân thành cám ơn bác.


  • 1
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#15 anhcos

anhcos

    biết lệnh hatchedit

  • Advance Member
  • PipPipPipPip
  • 263 Bài viết
Điểm đánh giá: 172 (tàm tạm)

Đã gửi 09 January 2014 - 10:22 AM

Gọi là lược bớt điểm thì đúng hơn, và hoàn toàn xử lý trên mảng dữ liệu chứa tọa độ điểm và mảng Bulge, chứ hoàn toàn không có thao tác vẽ vời trên này như mấy bác trên lầm tưởng nhé. Dữ liệu thay đổi, Cad sẽ tự cập nhật đúng hình dạng.

 

- Để lược bớt bác phải có một hệ số sai lệch:

+ đối với đường thẳng: nếu 2 đường thẳng liền nhau có góc lệnh nhỏ hơn hệ số thì xóa điểm/đỉnh đó ra khỏi danh sách, đây chỉ là thao tác mảng, với acad.net có khả năng còn đơn giản hơn nhiều.

+ đối với cung tròn: mình nhớ giabach có gởi bạn một đoạn code về việc xác định tâm và bán kinh từ giá trị bulge rất đơn giản trong .net mà. Tiêu chí lược bớt bạn tự suy nghĩ thêm đi.


  • 2
Clear sky!

MF Rock collection.

#16 conghoa

conghoa

    biết lệnh attdef

  • Members
  • PipPipPipPipPipPip
  • 417 Bài viết
Điểm đánh giá: 91 (tàm tạm)

Đã gửi 09 January 2014 - 11:38 AM

cái file psimple_psimplev.lsp mình gửi bên trên làm được cả với lwpolyline hở đó các bác, ngâm cứu trong file lisp đó chắc ra hết cách làm :)


  • 2

#17 gia_bach

gia_bach

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1441 Bài viết
Điểm đánh giá: 1433 (rất tốt)

Đã gửi 09 January 2014 - 04:18 PM

Gửi bạn tham khảo code C# xóa đỉnh thừa của Polyline

(chỉ xóa các đỉnh tại giao của 2 đ/thẳng, phần đỉnh tại giao của 2 cung tròn bạn tự nghiên cứu)

        [CommandMethod("PLineOptimize")]
        public void PLineOptimize()
        {
            Document doc = AcAp.DocumentManager.MdiActiveDocument;
            Database db = doc.Database;
            Editor ed = doc.Editor;

            PromptEntityOptions opts = new PromptEntityOptions("\nSelect a Polyline: ");
            opts.SetRejectMessage("Not a Polyline.");
            opts.AddAllowedClass(typeof(Polyline), true);
            PromptEntityResult per = ed.GetEntity(opts);
            if (per.Status != PromptStatus.OK) return;

            using (Transaction tr = db.TransactionManager.StartTransaction())
            {
                Polyline pl = (Polyline)tr.GetObject(per.ObjectId, OpenMode.ForRead);
                Polyline pline = (Polyline)pl.Clone();
                int lastIndex = pline.NumberOfVertices - 1;
                for (int i = 0; i < lastIndex - 1; i++)
                {
                    if (pline.GetStartWidthAt(i) != pline.GetEndWidthAt(i)) continue;
                    if (pline.GetStartWidthAt(i + 1) != pline.GetEndWidthAt(i + 1))
                    {
                        i++;
                        continue;
                    }
                    if (pline.GetStartWidthAt(i) != pline.GetEndWidthAt(i + 1)) continue;

                    double bul1 = pline.GetBulgeAt(i);
                    double bul2 = pline.GetBulgeAt(i + 1);
                    if (bul1 != 0) // Arc
                    {
                        // self Study 
                    }
                    else // Line
                    {
                        if (bul2 == 0)
                        {
                            Point2d sta = pline.GetPoint2dAt(i), mid = pline.GetPoint2dAt(i + 1), end = pline.GetPoint2dAt(i + 2);
                            if (System.Math.Abs((sta - mid).Angle - (mid - end).Angle) < 0.001)
                            {
                                pline.RemoveVertexAt(i + 1);
                                i--;
                                lastIndex--;
                            }
                        }
                    }
                }
                if (pline.Closed && pline.NumberOfVertices > 3)
                {
                    int i = pline.NumberOfVertices - 2;
                    if (pline.GetStartWidthAt(i) == pline.GetEndWidthAt(i)
                        && pline.GetStartWidthAt(i + 1) == pline.GetEndWidthAt(i + 1)
                        && pline.GetStartWidthAt(i) == pline.GetEndWidthAt(i + 1))
                    {
                        double bul1 = pline.GetBulgeAt(i);
                        double bul2 = pline.GetBulgeAt(i + 1);
                        if (bul1 != 0) // Arc
                        {
                            // do with Arc
                        }
                        else // Line
                        {
                            if (bul2 == 0)
                            {
                                Point2d sta = pline.GetPoint2dAt(i), mid = pline.GetPoint2dAt(i + 1), end = pline.GetPoint2dAt(0);
                                if (System.Math.Abs((sta - mid).Angle - (mid - end).Angle) < 0.001)
                                {
                                    pline.RemoveVertexAt(i + 1);
                                }
                            }
                        }
                    }
                }
                if (pline.NumberOfVertices < pl.NumberOfVertices)
                {
                    BlockTableRecord btr = (BlockTableRecord)tr.GetObject(db.CurrentSpaceId, OpenMode.ForWrite, false);
                    pline.SetDatabaseDefaults();
                    pline.ColorIndex = 6;
                    btr.AppendEntity(pline);
                    tr.AddNewlyCreatedDBObject(pline, true);
                    tr.Commit();
                }
                else
                    ed.WriteMessage("Nothing to Optimize.");
            }
        }

Nếu dùng VB.NET có thể sử dụng tool Convert Online tại : http://www.developer.../csharp-to-vb/ 

hoặc : http://c.thuvienit.c...-to-csharp.aspx


  • 1

#18 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6010 Bài viết
Điểm đánh giá: 3114 (tuyệt vời)

Đã gửi 09 January 2014 - 11:28 PM

Gọi là lược bớt điểm thì đúng hơn, và hoàn toàn xử lý trên mảng dữ liệu chứa tọa độ điểm và mảng Bulge, chứ hoàn toàn không có thao tác vẽ vời trên này như mấy bác trên lầm tưởng nhé. Dữ liệu thay đổi, Cad sẽ tự cập nhật đúng hình dạng.

 

- Để lược bớt bác phải có một hệ số sai lệch:

+ đối với đường thẳng: nếu 2 đường thẳng liền nhau có góc lệnh nhỏ hơn hệ số thì xóa điểm/đỉnh đó ra khỏi danh sách, đây chỉ là thao tác mảng, với acad.net có khả năng còn đơn giản hơn nhiều.

+ đối với cung tròn: mình nhớ giabach có gởi bạn một đoạn code về việc xác định tâm và bán kinh từ giá trị bulge rất đơn giản trong .net mà. Tiêu chí lược bớt bạn tự suy nghĩ thêm đi.

Hề hề hề,

Với sự góp ý của bác Anhcos và các bác khác, mình đã viết lại lisp dưới đây để giải quyết vấn đề được chặt chẽ hơn. mình đã test thử trên bản vẽ của chủ thớt và một vài trường hợp khá oái oăm khác thì thấy có vẻ như chấp nhận được. Mong chủ thớt và các bác khác test thử và cho thêm ý kiến để có thể hoàn thiện thêm.

Ở lisp này đã xét thêm trường hợp nếu các cung liền nhau nhưng có bán kính hoặc tâm cung khác nhau thì sẽ giữ nguyên hiện trạng, chỉ xóa các điểm nối tiếp giữa các cung có chung bán kính và tâm. Lisp này chỉ dùng với các lwpolyline kín. Trường hợp với lwpolyline hở thì cần phải sửa lại đôi chút. Mình sẽ bổ sung sau.

http://www.cadviet.c...adinhpline1.lsp


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#19 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6010 Bài viết
Điểm đánh giá: 3114 (tuyệt vời)

Đã gửi 10 January 2014 - 12:48 AM

Hề hề hề,

Với sự góp ý của bác Anhcos và các bác khác, mình đã viết lại lisp dưới đây để giải quyết vấn đề được chặt chẽ hơn. mình đã test thử trên bản vẽ của chủ thớt và một vài trường hợp khá oái oăm khác thì thấy có vẻ như chấp nhận được. Mong chủ thớt và các bác khác test thử và cho thêm ý kiến để có thể hoàn thiện thêm.

Ở lisp này đã xét thêm trường hợp nếu các cung liền nhau nhưng có bán kính hoặc tâm cung khác nhau thì sẽ giữ nguyên hiện trạng, chỉ xóa các điểm nối tiếp giữa các cung có chung bán kính và tâm. Lisp này chỉ dùng với các lwpolyline kín. Trường hợp với lwpolyline hở thì cần phải sửa lại đôi chút. Mình sẽ bổ sung sau.

http://www.cadviet.c...adinhpline1.lsp

 Đây là lisp đã bổ sung để có thể sử dụng được với cả các lwpolyline kín và lwpolyline hở.

http://www.cadviet.c...inhpline1_1.lsp


  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#20 Polyline

Polyline

    biết lệnh mirror

  • Members
  • PipPipPip
  • 159 Bài viết
Điểm đánh giá: 18 (tàm tạm)

Đã gửi 10 January 2014 - 09:29 AM

Lisp chạy tốt. Tuy nhiên mình đề nghị bổ sung thêm tính năng "Diet" (giảm béo) cho PLine. Nghĩa là cho phép xóa bớt đỉnh của PLine trong một điều kiện nào đó, ví dụ như góc tạo bởi 3 đỉnh liên tiếp lớn hơn 175độ (nó gần như thẳng hàng).


  • 1