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

tannguyen291

Thành viên
 Xem Hồ Sơ  Xem hoạt động của họ

  • Số lượng nội dung

    449

  • Đã tham gia

  • Lần ghé thăm cuối

  • Ngày trúng

    43

Bài đăng được đăng bởi tannguyen291

  6. Đã đăng · Trả lời báo cáo

    37 phút trước, ketxu đã nói:

    Có lẽ là nên check giao nhau trước khi thực hiện các phép copy, boolean ^^

    Không cần ạ. chỉ cần không xoá đối tượng đấy về sau là oke ạ. 

    (defun c:IRM (/ ent ss x enx)
  (setq 
    ent (car (entsel "\nSelect region A"))
    ss (ssget (list '(0 . "REGION") '(-4 . "<NOT") (assoc 8 (entget ent)) '(-4 . "NOT>")))
    ent (vlax-ename->vla-object ent)
    ss (mapcar 'vlax-ename->vla-object (acet-ss-to-list ss))
  )
  (foreach item ss
    (vla-boolean (setq enx (vla-copy item)) acintersection (vla-copy ent))
    (if (equal 0 (vla-get-area enx) 1e-8)
      (setq ss (vl-remove item ss))
    )
  )
  (initget 1 "Yes No")
  (setq x (getkword "Are delele region old? [Yes/No] <Yes> "))
  (if (eq "Yes" x)
    (mapcar 'vla-delete (cons ent ss))
  )
  (princ)
)

     

  7. Đã đăng · Trả lời báo cáo

    Bản full option gửi anh em nhé. 

    Có sử dụng thêm List Box with Filter của cụ lee.

    http://www.lee-mac.com/filtlistbox.html

    anh em dùng cái này nhé 

    (defun c:cfst (/ doc sty font lst system)
  (setq 
    doc (vla-get-activedocument (vlax-get-acad-object)) 
    sty (vla-get-textstyles doc)
    system (strcat (getenv "systemroot") "\\Fonts")
    font (vl-directory-files (vl-string-translate "/" "\\" system) nil 1)
    font (vl-remove-if-not '(lambda (x) (vl-string-search "TTF" (strcase x))) font)
  )
  (vlax-for s sty (setq lst (cons (vla-get-name s) lst)))
  (if (and   
        (setq lst (LM:filtlistbox "Select Style" lst t))
        (setq font (car (LM:filtlistbox "Select Font" font nil)))
        (setq font (strcat system "\\" font))
      )
    (foreach item lst
      (vla-put-fontfile (vla-item sty item ) font)
    )
  )
  (vla-regen doc acActiveViewport)
  (princ)
)

(defun LM:filtlistbox ( msg lst mtp / _addlist dch dcl des rtn sel tmp )
  (defun _addlist ( key lst )
    (start_list key)
    (foreach x lst (add_list x))
    (end_list)
    lst
  )
  (if (and
        (setq dcl (vl-filename-mktemp nil nil ".dcl"))
        (setq des (open dcl "w"))
        (write-line (strcat
          "filtlistbox : dialog { label = \"" msg "\"; spacer;"
          ": list_box { key = \"lst\"; width = 50; fixed_width = true; height = 15; fixed_height = true; allow_accept = true; "
          "multiple_select = " (if mtp "true" "false") "; }"
          ": edit_box { key = \"flt\"; width = 50; fixed_width = true; label = \"Filter:\"; }"
          "spacer; ok_cancel; }") des)
        (not (close des))
        (< 0 (setq dch (load_dialog dcl)))
        (new_dialog "filtlistbox" dch)
      )
    (progn
      (_addlist "lst" (setq tmp lst))
      (set_tile "lst" (setq rtn "0"))
      (set_tile "flt" "*")
      (action_tile "lst" "(setq rtn $value)")
      (action_tile "flt" (vl-prin1-to-string '(progn
        (setq 
          flt (strcat "*" (strcase $value) "*")
          sel (mapcar '(lambda ( n ) (nth n tmp)) (read (strcat "(" rtn ")")))
        )
        (_addlist "lst" (setq tmp (vl-remove-if-not '(lambda ( x ) (wcmatch (strcase x) flt)) lst)))
        (set_tile "lst" (setq rtn (vl-string-trim "()"
          (vl-princ-to-string (cond ((vl-sort (vl-remove nil (mapcar '(lambda ( x ) (vl-position x tmp)) sel)) '<))('(0)))))))
      )))
      (setq rtn (if (= 1 (start_dialog)) (mapcar '(lambda ( x ) (nth x tmp)) (read (strcat "(" rtn ")")))))
    )
  )
  (if (< 0 dch) (setq dch (unload_dialog dch)))
  (if (and (= 'str (type dcl)) (findfile dcl)) (vl-file-delete dcl))
  rtn
)

     

    • Like 1

  9. Đã đăng · Trả lời báo cáo

    Mình có thể sửa thêm để không cần nhập kích thước, k cần chọn phương thức trên dưới trái phải. tuy nhiên bạn cần hiểu vài việc:

    1. Bạn cần gửi bản vẽ lên. 

    2. Toàn bộ dim của bạn có phải cùng 1 dimstyle hay không, kích thước text có giống nhau k.

    3. Việc chọn toàn bộ cả bản vẽ là việc bất khả thi. Chỉ có thể chọn từng vùng nhỏ cho một loại hình nhất định.

  10. Đã đăng · Trả lời báo cáo

    Mình viết tàm tạm được 1 cái. nhưng không tự động đâu. bạn quét chọn rồi nhập khoảng cách, chọn phương thức sắp xếp. tự động khó Vler :)) 

    (defun c:SD (/ ss dis case lstdim i pt space enx toado )
  (setq 
    ss (acet-ss-to-list (ssget '((0 . "DIMENSION"))))
    dis (getdist "\nDistance")
  )
  (initget "Right Left Up Down")
  (if (not (setq case (getkword "\nSelect function sort! [Right/Left/Up/Down] <Down>")))
    (setq case "Down")
  )
  (setq  
    lstdim (sortdim_xtd ss case (/ dis 6))
    i 0
    pt (cdr (assoc 10 (entget (caar lstdim))))
  )
  (if (vl-string-search case "Down,Left") (setq dis (- dis)))
  (if (vl-string-search case "Down,Up")
    (progn
      (setq pt (cadr pt))
      (foreach item lstdim
        (setq space (+ pt (* i dis)))
        (foreach pair item
          (setq 
            enx (assoc 10 (entget pair))
            toado (list 10 (cadr enx) space 0)
          )
          (entmod (subst toado enx (entget pair)))
        )
        (setq i (1+ i))
      )
    )
    (progn
      (setq pt (car pt))
      (foreach item lstdim
        (setq space (+ pt (* i dis)))
        (foreach pair item
          (setq 
            enx (assoc 10 (entget pair))
            toado (list 10 space (caddr enx) 0)
          )
          (entmod (subst toado enx (entget pair)))
        )
        (setq i (1+ i))
      )
    )
  )
  (princ )
)

(defun sortdim_xtd (lst key fuzz / lst1 lst2 p1 p2 case1 case2 )
  (setq 
    case1 (if (vl-string-search key "Down,Up") 'cadr 'car)
    case2 (if (vl-string-search key "Down,Left") '> '<)
  )
  (while (car lst)
    (setq 
      lst1 (list (car lst))
      p1 (cdr (assoc 10 (entget (car lst))))
      lst (cdr lst)
    )
    (foreach item lst
      (setq p2 (cdr (assoc 10 (entget item))))
      (if (equal (apply case1 (list p1)) (apply case1 (list p2)) fuzz)
        (setq 
          lst1 (cons item lst1)
          lst (vl-remove item lst)
        )
      )
    )
    (setq lst2 (cons lst1 lst2))
  )
  (vl-sort lst2 
    '(lambda (a b / c d) 
       (setq 
         c (cdr (assoc 10 (entget (car a))))
         d (cdr (assoc 10 (entget (car b))))
       )  
       (apply case2 (list (apply case1 (list c)) (apply case1 (list d))))
    )
  )
)

    Lisp khó thế này mà không có Cà phê uống thì tiếc nhỉ. :))

  12. Đã đăng · Trả lời báo cáo

    mình có 1 lisp hay dùng để chuyển style toàn bộ bản vẽ về 1 font mong muốn. 

    Ví dụ mình thích dùng arial thì nhập:   arial.ttf

    sau đó toàn bộ bản vẽ sẽ chuyển qua arial.

    các bạn có thể dựa vào đoạn mã của mình để tuỳ chỉnh. :)) 

    (defun c:cfst (/ doc sty address)
  (vl-load-com)
  (setq	
    doc (vla-get-activedocument (vlax-get-acad-object))
    sty (vla-get-textstyles doc)
    address (strcat "C:\\Windows\\Fonts\\" (getstring "\nName Font:"))
  )
  (vlax-for s sty (vla-put-fontfile s address))
  (vla-regen doc acActiveViewport)
  (princ)
)

     

    • Like 1
    • Vote tăng 1

  17. Đã đăng · Trả lời báo cáo

    Nếu bạn muốn gửi mình ly cà phê thì có thể inbox nha. :D

    Lệnh IRM: chọn region A. rồi quét chọn toàn bộ. (lisp tự bỏ qua layer của region A)

    Lưu ý vì đặc tính của intersect nên nếu region X và region A không có giao nhau. region X sẽ bị xoá. Bạn không nên chọn các region không giao nhau với region A. 

    (defun c:IRM (/ ent ss x)
  (setq 
    ent (car (entsel "\nSelect region A"))
    ss (ssget (list '(0 . "REGION") '(-4 . "<NOT") (assoc 8 (entget ent)) '(-4 . "NOT>")))
    ent (vlax-ename->vla-object ent)
    ss (mapcar 'vlax-ename->vla-object (acet-ss-to-list ss))
  )
  (foreach item ss
    (vla-boolean (vla-copy item) acintersection (vla-copy ent))
  )
  (initget 1 "Yes No")
  (setq x (getkword "Are delele region old? [Yes/No] <Yes> "))
  (if (eq "Yes" x)
    (mapcar 'vla-delete (cons ent ss))
  )
  (princ)
)

     

  18. Đã đăng · Trả lời báo cáo

     

    Vào lúc 30/12/2022 tại 12:11, NTHAHT đã nói:

    Còn trường hợp này nữa, trong đó:

    -> Ngoài là cái Rectang, trong là cái block, block này bao gồm:

    - DT1 là Mtext

    - TB-01 là ATT (multiline)

     - BLOCK-1 là Multileader.

     - Rectang màu đỏ.

     *** Đối với Hatch thì các đối tượng đó được bỏ qua.

    image.png.40c4987e172a8d07e5b2a75729046807.png

     

    Như vậy có thể dùng lọc tuỳ chỉnh. không quá khó đâu bạn 

    (defun BoundaryAreaPoint (pt / ent lst area ss)
  (setq 
    ent (entlast)
    ss (ssget "All" '((0 . "............"))  ;;;>>>>> đối tượng muốn lọc <<<<<;;;;;;
  )
  (vl-cmdf "_.boundary" "A" "B" "N" ss "" "I" "Y" "O" "R" "X" pt "")
  (while (setq ent (entnext ent))
    (setq lst (cons (vlax-ename->vla-object ent) lst))
  )
  (if (< 1 (length lst))
    (progn
      (setq lst (vl-sort lst '(lambda (a b) (> (vla-get-area a) (vla-get-area b)))))
      (foreach item (cddr lst)
        (vla-boolean (cadr lst) acunion item)
      )
      (vla-boolean (car lst) acsubtraction (cadr lst))
    )
  )
  (setq  area (vla-get-area (CAR lst)))
  (LIST area (CAR lst))
)

  19. Đã đăng · Trả lời báo cáo

    20 giờ trước, snowman.hms đã nói:

    image.png.2a821bd977dd87a1eb7fe687a5a6cbf0.png 

     

    - Nếu đường cong cần tìm là đường tròn, và nếu điểm tiếp xúc với đường thẳng là điểm cuối (A)

     thì

       + tâm đường cong cần tìm nằm trên đường thẳng tại A và vuông góc với đoạn thẳng cho trước

       + khoảng cách từ tâm đường tròn cần tìm (O1) đến tâm đường tròn cho trước = khoảng cách từ điểm đó đến điểm A1 (offset theo cùng hướng một khoảng đúng bằng bán kính đường tròn cho trước)

       + tâm đường tròn cần tìm là giao điểm giữa đường trung trực của OA1 và AA1.

    Vâng đây là một kết quả chính xác ạ. ngoài ra có thể dùng lisp để tính toạ độ theo phương trình đường tròn tuy nhiên khá phức tạp. 

    còn 1 cách khác. sử dụng parametric với các ứng dụng Constrain cũng là một lựa chọn tốt

    image.thumb.png.c75b16c5f7673829ecf13a454fa01911.png

  21. Đã đăng · Trả lời báo cáo

     Bạn dùng lisp mình viết xem sao. lisp kia nhìn hơi quê. Lệnh MLE nhé 

    (defun c:MLE (/ ss i obj lst1 p1 p2)
  (setq ss (ssget '((0 . "*POLYLINE"))))
  (repeat (setq i (sslength ss))
    (setq 
      i (1- i)
      obj (vlax-ename->vla-object (ssname ss i))
      lst1 (vlax-safearray->list (vlax-variant-value (vla-explode obj)))
      lst1 (vl-sort lst1 '(lambda (a b) 
                            (> (vlax-curve-getDistAtParam a (vlax-curve-getEndParam a)) 
                               (vlax-curve-getDistAtParam b (vlax-curve-getEndParam b)))))
      p1 (vlax-3d-point (vlax-curve-getstartpoint (car lst1)))
      p2 (vlax-3d-point (vlax-curve-getendpoint (car lst1)))
    )
    (mapcar 'vla-delete lst1)
    (vla-Mirror obj p1 p2)
    (vla-delete obj)
  )
  (princ)
)

     

    • Vote tăng 1

  23. Đã đăng · Trả lời báo cáo

    12 giờ trước, 7o7 đã nói:

    Chắc lâu qúa chẳng tìm được link cũ, thôi bác thớt cứ giải luôn cho xong.

     Tôi cũng xin góp ý cách tìm tâm đg tròn tiếp tuyến :

     - vẽ đg thẳng góc với đg thẳng từ tâm vòng tròn, đó là bk vt tiếp tuyến

     - vẽ đg song song với đg thẳng từ tâm vòng tròn

     từ các yếu tố trên suy ra tâm  đg tròn tiếp tuyến.

      

    1.png.53584ed8a0aa5877ea9d9e03a72b1120.png

     

    đường cong của bác tuy đạt yếu tố tiếp tuyến nhưng chưa đạt yêu cầu ạ. điểm tiếp tuyến là điểm cuối trên đoạn thẳng. bác thử nghĩ thêm xem sao nhé

    image.thumb.png.71727f715df245a23b7310818b94fdef.png

     

     

×