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

quocmanh04tt

Thành viên
  • Số lượng nội dung

    1123
  • Đã tham gia

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

  • Ngày trúng

    153

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


  1. Vào lúc 13/4/2022 tại 15:03, 7o7 đã nói:

    Tâm boundingbox với điểm chèn block Center cũng có kc chứ chưa hẳn đã trùng, do đó nếu có 2 bl N-Thua cách nhau nhỏ hơn kc đó thì kết quả không còn đúng.

    Về lý thuyết thì đúng như vậy bạn, nhưng đây là bài toán thực tế và mình cũng đã nói ở trên "... ít gặp rắc rối hơn..."

    Vào lúc 13/4/2022 tại 16:20, MrCGIS đã nói:

    Em cảm ơn anh lisp sài rất tốt nếu quét chọn những vùng nhỏ ạ....Tks anh nhiều

    Có lẽ Zoom lên để quét vùng lớn...

    (defun c:tt  (/ blc cen ent llp mid obj ss1 ss2 urp)
      (if (setq ss1 (ssget '((0 . "INSERT") (2 . "N_THUA_*"))))
        (while (and (setq ent (ssname ss1 0)) (ssdel ent ss1))
          (vla-getboundingbox (setq obj (vlax-ename->vla-object ent)) 'llp 'urp)
          (vla-ZoomWindow (vlax-get-acad-object) llp urp)
          (setq llp (vlax-safearray->list llp)
                urp (vlax-safearray->list urp)
                mid (mapcar '(lambda (m n) (* (+ m n) 0.5)) llp urp)
                cen nil)
          (cond ((setq ss2 (ssget "C" llp urp '((0 . "INSERT") (2 . "CENTRD_1"))))
                 (while (and (setq blc (ssname ss2 0)) (ssdel blc ss2))
                   (setq cen (cons (cdr (assoc 10 (entget blc))) cen)))
                 (setq cen (vl-sort cen '(lambda (x y) (< (distance mid x) (distance mid y)))))
                 (vlax-invoke obj 'scaleentity (car cen) 0.01)))
          (vla-ZoomPrevious (vlax-get-acad-object))))
      (princ))

     


  2. Mình đi theo hướng như đã nói ở trên.

    (defun c:tt  (/ blc cen ent llp mid obj ss1 ss2 urp)
      (if (setq ss1 (ssget '((0 . "INSERT") (2 . "N_THUA_*"))))
        (while (and (setq ent (ssname ss1 0)) (ssdel ent ss1))
          (vla-getboundingbox (setq obj (vlax-ename->vla-object ent)) 'llp 'urp)
          (setq llp (vlax-safearray->list llp)
                urp (vlax-safearray->list urp)
                mid (mapcar '(lambda (m n) (* (+ m n) 0.5)) llp urp)
                cen nil)
          (cond ((setq ss2 (ssget "C" llp urp '((0 . "INSERT") (2 . "CENTRD_1"))))
                 (while (and (setq blc (ssname ss2 0)) (ssdel blc ss2))
                   (setq cen (cons (cdr (assoc 10 (entget blc))) cen)))
                 (setq cen (vl-sort cen '(lambda (x y) (< (distance mid x) (distance mid y)))))
                 (vlax-invoke obj 'scaleentity (car cen) 0.01)))))
      (princ))

     

    • Like 1
    • Vote tăng 1

  3. 9 giờ trước, hawking312 đã nói:

    cảm ơn bác đã giúp đỡ, nhưng chưa phải ý của mình, nó như thế này. Nó là 1 lisp trong bộ cài Speedcad, lệnh R90 để rotate 90 độ, R-90 để rotate ngược lại 90 độ, ... Mong muốn nhờ mọi người giúp viết lại thành lisp để có thể thêm lệnh R0, Nhờ bác giúp ạ, cảm ơn bác
    https://files.fm/f/2h7t6bc95
     

    - Ố ố ... Lisp của mình đáp ứng được mà! Bạn gõ lệnh R90 hay R91, R92, R-93 ... R130... đều được (số bất kỳ nằm sau R là được).

    - Còn cái R0 bạn nói thì may ra làm được với *Text, Block (các đối tượng có thông tin về góc xoay), với nhóm đối tượng bất kỳ thì khó mà khả thi.


  4. Hehehe...

    - Chỉ là giải quyết bài toán của chủ thớt thì lisp ổn rồi, cũng như chỉ cần lisp của Mr. Cuong ở trên cũng đã ok mà lại ngắn gọn (chỉ cần đưa hệ toạ độ về đúng vị trí của nó - thông qua lệnh UCS, nếu là cad đời cao chỉ cần pick vào cái biểu tượng và kéo là được).

    - Ở trên thấy bác nói không dùng command, việc này đồng nghĩa với việc phải sử dụng nhiều kiến thức về lisp hơn (nhất là liên quan đến UCS), nên anh em chờ bác post để tham khảo (nói như Mr. alisp ở trên).

    -  Vấn đề này thì chỉ sửa lại lisp của Mr. Cuong chút xíu... là đáp ứng được.

    Vào lúc 27/10/2021 tại 11:38, thiep đã nói:

    từ điểm pick, lisp hiểu sẽ tạo 2 dimordinate ở 2 điểm quadrant nào, không nên cứng nhắc chỉ là tạo 2 dimordinate dưới và phải.

    (defun c:tt  (/ cen ent lsp poi rad sel)
      (while (setq sel (entsel "\nPick duong tron:"))
        (setq ent (entget (car sel))
              cen (trans (acet-dxf 10 ent) 0 1)
              rad (acet-dxf 40 ent)
              poi (cadr sel)
              lsp (mapcar '(lambda (x / p) (setq p (polar cen (* x pi) rad)) (list p (polar p (* x pi) 1.2)))
                          '(0 1 0.5 1.5))
              lsp (vl-sort lsp '(lambda (x y) (> (distance (car x) poi) (distance (car y) poi)))))
        (mapcar '(lambda (x) (command "_dimordinate" "_none" (car x) "_none" (cadr x)))
                (cddr lsp)))
      (princ))


  5. 21 phút trước, thiep đã nói:

    Cũng có thể @quocmanh, bới vậy khi BV đang ở UCS, Thiệp đưa về WCS, sau khi chạy lisp thì trả về UCS cũ. Tuy nhiên, cũng chưa biết có ổn không, Thiệp thử ở cad 2007 thấy ok.

    Bác thử xoay UCS 1 góc nào đó để kiểm tra.

    Bản vẽ của chủ thớt hình như là lĩnh vực cơ khí, không phải chuyên môn nhưng mình đoán bốn điểm của hình tròn cần đo là các điểm mà khi chiếu vuông góc xuống các trục toạ độ sẽ có các giá trị cực tiểu và cực đại.

    Lisp của bác 4 điểm đó với tính chất trên lại luôn thuộc WCS.


  6. 2 giờ trước, thiep đã nói:

    Lệnh po0: tạo điểm quy chiếu, (giống như dời điểm gốc hệ toạ độ (0 0 0) về điểm này)

    Lệnh TDT: tạo DimOrdinate cho CIRCLE, ARC

    
    ;;;Lisp AdddimOrdinate cho tâm CIRCLE, ARC         by Trân Thiêp 10/2021, tel 0918841230
    (defun c:po0 (/)
        (setq po0
                 (getpoint '(0 0 0)
                     "\nPick 1 \U+0111i\U+1EC3m to\U+1EA1 \U+0111\U+1ED9 quy chi\U+1EBFu"
                 )
        )
    )
    (defun c:tdt (/ doc      *model   ucs_old  po13_1   po14_1   po13_2   po14_2
                    90d      270d     360d     ent      centpo   eng      ang
                    R        obdX     obdY     engX     engY     entodimX entodimY
                    sel      popick
                   )
        (setq doc    (vla-get-ActiveDocument (vlax-get-acad-object))
              *model (vla-get-modelspace doc)
        )
        (defun *error* (msg)
            (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
                (princ (strcat "\n** Error: " msg " **"))
            )
            (acet-sysvar-restore)
            (vla-EndUndoMark doc)
            (princ)
        )
        (vla-StartUndoMark doc)
        (acet-sysvar-set (list "cmdecho" 0 "osmode" 33))
        (setq ucs_old (acet-ucs-get nil))
        (acet-ucs-cmd '("w"))
        (setq 90d  (/ pi 2)
              360d (* pi 2)
              270d (* 90d 3)
        )
        (or po0 (setq po0 (getpoint "\nPick 1 \U+0111i\U+1EC3m to\U+1EA1 \U+0111\U+1ED9 quy chi\U+1EBFu")))
        (setvar "osmode" 0)
        (while
            (OR (NOT (setq sel (entsel "\nPick a CIRCLE, ARC")))
                (NOT (wcmatch (acet-dxf 0 (setq eng (entget (setq ent (car sel)))))
                              "CIRCLE,ARC"
                     )
                )
            )  (prompt "\nPick ch\U+01B0a Ðúng CIRCLE, ARC vui lòng pick l\U+1EA1i")
        )
        (setq popick (cadr sel))
        (setq centpo (trans (acet-dxf 10 eng) 0 1)
              R      (acet-dxf 40 eng)
        )
        (setq ang (angle centpo popick))
        (cond ((< 0 ang 90d)
               (setq po13_1 (polar centpo 0 R)
                     po14_1 (polar po13_1 0 10)
                     po13_2 (polar centpo 90d R)
                     po14_2 (polar po13_2 90d 10)
               )
              )
              ((< 90d ang pi)
               (setq po13_1 (polar centpo pi R)
                     po14_1 (polar po13_1 pi 10)
                     po13_2 (polar centpo 90d R)
                     po14_2 (polar po13_2 90d 10)
               )
              )
              ((< pi ang 270d)
               (setq po13_1 (polar centpo pi R)
                     po14_1 (polar po13_1 pi 10)
                     po13_2 (polar centpo 270d R)
                     po14_2 (polar po13_2 270d 10)
               )
              )
              ((< 270d ang 360d)
               (setq po13_1 (polar centpo 0 R)
                     po14_1 (polar po13_1 0 10)
                     po13_2 (polar centpo 270d R)
                     po14_2 (polar po13_2 270d 10)
               )
              )
        )
        (setq obdX (vla-AddDimOrdinate *model
                                       (vlax-3d-point (trans po13_1 1 0))
                                       (vlax-3d-point (trans po14_1 1 0))
                                       :vlax-false
                   )
        )
        (setq obdY (vla-AddDimOrdinate *model
                                       (vlax-3d-point (trans po13_2 1 0))
                                       (vlax-3d-point (trans po14_2 1 0))
                                       :vlax-true
                   )
        )
        (setq engX (entget (setq entodimX (vlax-vla-object->ename obdX))))
        (entmod (subst (cons 10 po0) (assoc 10 engX) engX))
        (entupd entodimX)
        (setq engY (entget (setq entodimY (vlax-vla-object->ename obdY))))
        (entmod (subst (cons 10 po0) (assoc 10 engY) engY))
        (entupd entodimY)
        (acet-sysvar-restore)
        (acet-ucs-set ucs_old)
        (vla-EndUndoMark doc)
        (princ "\nOk")
        (princ)
    )

    Chúc vui vẻ. Thiep

    @thiepCó vẻ chưa ổn trong UCS bác ạ!


  7. Vào lúc 1/8/2021 tại 00:41, moitapchoicad đã nói:

     

    Nếu lisp của bạn giải quyết được đối tượng là line, arc, spline, và có thể lấy được miền trong của chi tiết chính như các lỗ, cắt khoét thì tốt. 

    Tưởng là thì gì khác, chứ thì tốt thì mình chịu. hehehe ...

    Tuy nhiên bài toán của bạn có thể giải quyết được, bằng cách viết lại lisp khác.


  8. 20 giờ trước, benanphal93 đã nói:

    vâng em xin lỗi các bác!

    như hình đính kèm thì em muốn lưu mỗi chi tiết thành 1 file riêng với tên file là phần text trên mỗi chi tiết ạ!.

    Mong các bác giúp em với ạ!  Em cảm ơn!

     

    Capture.PNG

    Nếu các chi tiết như hình là các pline (1 chi tiết là 1 lwpolyline), text (không phải Mtext, Rtext), thì bạn dùng lisp này:

     

    TCT.rar


  9. Vào lúc 27/6/2021 tại 12:34, thiep đã nói:

    Theo Thiep nghĩ, bạn đã dùng 1 lisp để insert block thép dầm này, trong lisp có liên kết field chiều dài polyline vào trong ATT, nếu bạn có thể share cho lisp này cho Thiep xem thì quý hoá. Thiệp cũng lisp liên kết chiều dài kiểu này vào trong ATT nhưng chiều dài không phải là 1 polygon mà là 1 thuộc tính động của block động.

    Bạn cũng nên đổi tên block thành không dấu, cho không bị lỗi vặt.

     

    Cái block trên kia giá trị chiều dài cũng là tổng mấy cái thuộc tính (Parameter) của block động mà bác!


  10. - Topic tham khảo là slide_image, còn code minh họa lại là vector_image, 2 loại này có khác nhau đó bạn.

    - Với code bạn gửi, bạn thử thay hàm logo trong lisp bằng hàm mới dưới đây xem sao:

    (defun logo  (key / hei wid vec)
      (setq wid (dimx_tile "logo")
            hei (dimy_tile "logo")
            vec (lambda (d l) (mapcar '(lambda (x) (fix (+ d (* x (/ d -10))))) l)))
      (start_image key)
      (mapcar 'vector_image
              (vec wid '(1 1 9))
              (vec hei '(4 6 6))
              (vec wid '(1 9 9))
              (vec hei '(6 6 4))
              '(1 1 1))
      (end_image))

    P/s: Bạn test với nhiều trường hợp (thay đổi: width = ... height = ... của tile logo xem).

    • Like 1

  11. Vào lúc 20/6/2021 tại 11:06, thanhdn đã nói:

    nhân tiện các anh chị có thể thêm vào lisp dòng nhắc 

    + chọn cao độ text khi xuất ra hoặc chọ text có sẵn

    + số lẻ sau dấu phảy

    để cho nó phù hợp với các bản vẽ không ạ, xin cảm ơn các anh chị đã đọc

    Dòng màu đỏ là sao bạn nhỉ???

×