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

    406

  • Đã tham gia

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

  • Ngày trúng

    40

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

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

    Sau quá nhiều bình luận mình vẫn cho rằng đã viết lisp thì không thể phiên phiến được kéo điểm, nối thêm nét... . phải chính xác

    Dựa trên lý thuyết của bác @duy782006 là tạo ra 3 đường thẳng có các góc tạo ra bằng nhau thì mình viết 1 lisp chọn 2 đường line sau đó nhập độ dài 1 cạnh: 

    (defun c:test (/ ent1 ent2 ent pp1 pp2 ptx obj1 obj2 a1 a2 bankinh dis dis1 dis2)
  (setq 
    ent1 (entsel "\nChon DT1")
    ent2 (entsel "\nChon DT2")
    dis (getdist "\nDo dai cac doan thang")
    pp1 (trans (cadr ent1) 1 0 )
    pp2 (trans (cadr ent2) 1 0 )
    ent1 (vlax-ename->vla-object (car ent1))
    ent2 (vlax-ename->vla-object (car ent2))
    pp1 (vlax-curve-getclosestpointto ent1 pp1 )
    pp2 (vlax-curve-getclosestpointto ent2 pp2 )
    ptx (vlax-invoke ent1 'intersectwith ent2 acExtendBoth)
    a1 (angle ptx pp1)
    a2 (angle ptx pp2)
  )
  (if (> a1 a2)
    (if (< (- a1 a2) pi)
      (setq a1 (- a1 a2))
      (setq a1 (+ pi pi a2 (- a1)))
    )
    (if (< (- a2 a1) pi)
      (setq a1 (- a2 a1))
      (setq a1 (+ pi pi a1 (- a2)))
    )
  )
  (setq 
    a2 (+ (* 0.375 pi) (/ a1 8))
    bankinh (abs (/ dis 2 (cos a2)))
    dis1 (abs (* bankinh (sin a2)))
    dis2 (abs (- (* dis1 (cos (/ a1 2)) (/ 1 (sin (/ a1 2))) ) (/ dis 2)))
  )
  (vl-cmdf "offset" dis1 (vlax-vla-object->ename ent1) (trans pp2 0 1) "")
  (setq obj1 (vlax-ename->vla-object (entlast)))
  (vl-cmdf "offset" dis1 (vlax-vla-object->ename ent2) (trans pp1 0 1) "")
  (setq obj2 (vlax-ename->vla-object (entlast)))
  (setq ptx (vlax-invoke obj1 'intersectwith obj2 acExtendBoth))
  (vla-delete obj1)
  (vla-delete obj2)
  (setvar "CHAMFERA" dis2)
  (setvar "CHAMFERB" dis2)
  (vl-cmdf "CHAMFER" (trans pp1 0 1) (trans pp2 0 1))
  (setq 
    ent (entget (entlast))
    pp1 (cdr (assoc 10 ent))
    pp2 (cdr (assoc 11 ent))
  )
  (entdel (cdar ent))
  (setq 
    a1 (angle ptx pp1)
    a2 (angle ptx pp2)
    obj1 (vlax-ename->vla-object (entmakex (list '(0 . "ARC") (cons 10 ptx) (cons 40 bankinh) (cons 50 a1) (cons 51 a2))))
    obj2 (vlax-ename->vla-object (entmakex (list '(0 . "ARC") (cons 10 ptx) (cons 40 bankinh) (cons 50 a2) (cons 51 a1))))
  )
  (if (> (vlax-curve-getdistatparam obj1 (vlax-curve-getendparam obj1)) (vlax-curve-getdistatparam obj2 (vlax-curve-getendparam obj2)))
    (mapcar 'set '(obj1 obj2 pp1 pp2) (list obj2 obj1 pp2 pp1))
  )
  (vla-delete obj2)
  (setq 
    obj2 (vlax-curve-getdistatparam obj1 (vlax-curve-getendparam obj1))
    a1 (vlax-curve-getpointatdist obj1 (/ obj2 3))
    a2 (vlax-curve-getpointatdist obj1 (* 2 (/ obj2 3)))
  )
  (vla-delete obj1) 
  (entmakex (list '(0 . "LINE") (cons 10 pp1) (cons 11 a1)))
  (entmakex (list '(0 . "LINE") (cons 10 a1) (cons 11 a2)))
  (entmakex (list '(0 . "LINE") (cons 10 a2) (cons 11 pp2)))
  (princ)
)

     

    • Like 1

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

    10 phút trước, cuongtk2 đã nói:

    Mình xây tường rào có khẩu độ mong muốn 3.4m trên ranh giới vuông góc được fillet bởi R6.0. Đoạn rào giữa có trung điểm nằm trên góc phân giác ranh giới.  Bạn nào giúp mình lệnh bấm phát ra MB các đoạn rào nhé. Thanks. (Nếu các bạn không luận được mình sẽ vẽ hình minh hoạ)

    Thuật toán thì em đã giải phía trên rồi. viết lisp theo đó không hề khó mà

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

    17 phút trước, thuyen mai đã nói:

    Dạ cái chiều dài 3.4 kia của e không cố định bác ạ. Nên thiếu thì sẽ tăng chiều dài lên bác ạ

    Tốn nơron thần kinh với bạn quá. dùng lệnh DIV của cad cho nhanh.

     

    9 phút trước, duy782006 đã nói:

    Lâu nay mình cứ thắc mắc học toán hình học và lượng giác thì ứng dụng được cái giống gì trong công việc. Có bé kia bảo với mình thì ít ra lập trình cần giỏi toán, nay thấy đúng là cần thiệt. Mấy kiến thức này của mình heo ủi hết trọi.

    cái này nó chỉ đơn giản SIN đi học, COS không hư thôi mà bác. chứ mấy cái tính toán biến đổi lượng giác em cũng chịu.

    • Like 1

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

    Vừa xong, thuyen mai đã nói:

    Dạ vâng đúng là bài của e là nếu thiếu thì lấy line 2 bên bù vào ạ

    Bạn vẽ thật ba phải. 

    Bài này nếu vẽ theo cách anh @duy782006

    Thì lý thuyết phải là G2 = 135+g1/4 ; G3 = G2/2

    R =  1.7/cos(g3)

    H = 1.7*tan(g3)

    bắt đầu vẽ offset 2 đường line 1 khoảng  = H

    xác định được tâm O là giao của 2 đường

    vẽ đường ARC với tâm O , bán kinh R.

    DIV đường cong  là xong.

    từ đây có cơ sở viết lisp

    image.png.d4f91d689da1b56f34fff932db84e3b7.png

     

     

    • Like 2

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

    @thuyen mai 

    Phương pháp vẽ của bạn có vấn đề. Điểm A và B phải trùng nhau mới là chính xác nhất. suy ra R1 phải bằng 1 số khác, không cố định cần phải tính toán thêm.

     

    image.thumb.png.928c98bb3a52119d8948f15d82839fc8.png

     

    13 giờ trước, duy782006 đã nói:

    Theo mình hợp lý nhất là 3 đường thẳng mới và 2 đường thẳng cũ hợp với nhau tạo thành các góc bằng nhau. Tìm mối liên hệ giữa góc tạo bởi 2 đường thẳng cũ và góc mới. Áp dụng các kiến thức về toán hình học hoặc lượng giác để tìm ra các thông số sau đó dựng hình. Mình lảm nhảm vậy thôi chứ trình mình làm là hông nổi.

    

    không biết cách vẽ của bác hay cách vẽ của em mới là đúng

     

    image.png

    • Like 1

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

    52 phút trước, cuongtk2 đã nói:

    Với autolisp , bạn không thể làm ở hàng loạt bản vẽ một cách im lìm. Phải dùng .NET

    Autolisp làm được bác.

    chỉ là cách làm hơi mất công thôi.

    vẫn dùng cách cũ 

    (setvar 'clayer "0") (command "QSAVE" "CLOSE")

     cài auto load. mở một đống bản vẽ là xong. 

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

    Có một cách ngày xưa vẫn hay dùng để fix nhiều bản vẽ cùng lúc.

    viết 1 lisp chạy trực tiếp khi load dùng để làm gì đó cuối lệnh là save và close bản vẽ

    mở cad cài startup suite tìm đến file lisp (tự động load lisp khi mở bản vẽ đó). 

    mở toàn bộ file dwg muốn fix là xong.

    đổi tên file lisp hoặc xoá đi để không chạy lisp đó nữa.

    • Like 1

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

    cũng được  

    (defun C:DMTC ( / doc col r g b )
  (vl-load-com)
  (setq doc (vla-get-activedocument (vlax-get-acad-object)))
  (vla-startundomark doc)
  (mip:layer-status-save)
  (cond 
    ((not (setq col (acad_truecolordlg '(62 . 7)))))
    ( (assoc 420 col)
      (setq 
        col (cdr (assoc 420 col))
        r (fix (/ col 65536))
        g (fix (/ (- col (* 65536 r)) 256))
        b (- col (* 65536 r) (* 256 g))
      )
      (ChangeAllObjectsColor doc (list r g b))
    )
    (t (ChangeAllObjectsColor doc (cdar col)))
  )
  (mip:layer-status-restore)
  (vla-endundomark doc)
  (princ)
)
(princ "\nType ColorX in command line")
(defun mip:layer-status-restore ()
  (foreach item *MIP_LAYER_LST*
    (if (not (vlax-erased-p (car item)))
      (vl-catch-all-apply
        '(lambda ()
          (vla-put-lock (car item) (cdr (assoc "lock" (cdr item))))
          (vla-put-freeze (car item) (cdr (assoc "freeze" (cdr item))))
        ) ;_ end of lambda
      ) ;_ end of vl-catch-all-apply
    ) ;_ end of if
  ) ;_ end of foreach
  (setq *MIP_LAYER_LST* nil)
) ;_ end of defun

(defun mip:layer-status-save ()
  (setq *MIP_LAYER_LST* nil)
  (vlax-for item (vla-get-layers (vla-get-activedocument (vlax-get-acad-object)))
    (setq *MIP_LAYER_LST* (cons (list item
                                  (cons "freeze" (vla-get-freeze item))
                                  (cons "lock" (vla-get-lock item))
                                ) ;_ end of cons
                            *MIP_LAYER_LST*
                          ) ;_ end of cons
    )  ;_ end of setq
    (vla-put-lock item :vlax-false)
    (if (= (vla-get-freeze item) :vlax-true)
      (vl-catch-all-apply '(lambda () (vla-put-freeze item :vlax-false)))
    )
  ) ;_ end of vlax-for
) ;_ end of defun
(defun ChangeAllObjectsColor (Doc Color / tc )
  (vlax-for Blk (vla-get-Blocks Doc)
    (if (= (vla-get-IsXref Blk) :vlax-false)
      (vlax-for Obj Blk
        (if (vlax-property-available-p Obj 'Color)
          (if (listp Color)
            (progn
              (setq tc (vla-get-truecolor Obj))
              (apply 'vla-setrgb (cons tc Color))
              (vla-put-truecolor Obj tc)
            )
            (vla-put-Color Obj Color)
          )
        )
      )
    )
  )
)

     

    • Like 2

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

    3 giờ trước, duy782006 đã nói:

    Hỏi nửa thì ngại nhưng bí nên lại hỏi. Mình muốn tập hợp là object tạo ra từ ssget, và xếp theo giá trị tag từ nhỏ đến lớn luôn với nhồi từ trưa giờ mà không được! Cảm ơn nhiều.

     

    Thì bạn dùng hàm của mình

    (setq ss (acet-ss-to-list (ssget)))

    (setq lst (mapcar 'vlax-ename->vla-object ss))

    (setq lst (xepatt lst "TENTAG" '<))

    chỉ việc dùng thôi mà.

     

     

    • Vote tăng 1

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

    @duy782006

    taphopbl : list vla-object

    tentag : name attributes

    func: methods (VD: '< '> '(lambda ...)) 

    (defun xepatt ( taphopbl tentag func / gettextstringatt lst )
  (defun gettextstringatt (obj / att)
    (vl-some '(lambda (x) (if (eq tentag (vla-get-tagstring x)) (setq att (vla-get-textstring x)))) (vlax-invoke obj 'getattributes))
    att
  )
  (setq lst (vl-sort-i (mapcar 'gettextstringatt taphopbl) func))
  (mapcar '(lambda (x) (nth x taphopbl)) lst)
)

     

    • Like 1

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

    1 giờ trước, sam8xd đã nói:

    Các bác tham khảo cách tạo Viewport này

     

    Ông anh câu view câu like vừa vừa thôi. tương tác thì ít hút trà sữa là nhiều.

    Ông em @limfx là người biết code muốn hỏi thuật toán chứ muốn mua về dùng đâu. 

    chả lẽ lại thấy bác ở đâu vote giảm ở đấy.

    • Like 1

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

    14 phút trước, limfx đã nói:

    Thì bản chất code cũng là người sau copy người đi trước rồi chỉnh sửa lại thôi mà!

    Anh tannguyen291 lấy cái acet-ss-to-list thấy nhanh nhỉ! Em thì dùng (mapcar 'cadr (ssnamex (ssget)))

     Lệnh MWW một cách khác để chủ thớt tham khảo!

    Move on wipeout (MWW).lsp

    mấy cái acet của express tool. ông nào cài cad mà bỏ tick cái này thì lisp tịt k chạy. haha. 

    được cái tiện phết.

    lisp của bạn không viết dấu cách cái getpoint chưa chắc lisp đã chạy đâu kìa. mà sao không để pause pause trong command thao tác người dùng sướng hơn.

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

    1 giờ trước, ketxu đã nói:

    Bạn load lisp dưới.
    Thao tác : lệnh SF hoặc SF1
    B1 :chọn các đối tượng trong vùng chọn -> B2 : Chọn đối tượng cơ sở -> Các đối tượng có order trên đối tượng này sẽ được chọn.
    Lệnh Lệnh SF1 thì nhanh hơn nhưng yêu cầu B1 phải quét chọn trong 1 nhịp, k chọn nhay nhay :D

    Select Front.zip

    Lệnh của bác có chi ghê gớm mà đóng gói kỹ vậy bác. 

    em nghĩ cũng chỉ đơn giản là: 

    (defun c:test (/ ss ent p)
  (ssgetfirst)
  (setq 
    ss (acet-ss-to-list (ssget "C" (setq p (getpoint)) (getcorner p)))
    ent (car (entsel))
    ss (cdr (member ent (reverse ss)))
  )
  (sssetfirst nil (acet-list-to-ss ss))
  (princ)
)

    ssget "C" thì không chọn nhay nhay được :))

    hoặc có thể dùng (ssget "CP" (acet-ui-fence-select)) thì có thể chọn trong vùng k phải chữ nhật.

    • Vote tăng 1
    • Vote giảm 1
×