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

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

    thớt dùng cái này của mình xem sao

    lệnh Move text dim: MTD

    Lệnh đảo text dim: RVD 

    (defun c:mtd (/ ss dis i eng pt1 pt2 pt3 pt4 ang)
  (setq 
    ss (ssget '((0 . "DIMENSION"))) i (sslength ss)
    dis (getdist "\nDistance Dim:")
  )
  (repeat i
    (setq 
      i (1- i)
      eng (entget (ssname ss i))
      pt1 (cdr (assoc 13 eng))
      pt2 (cdr (assoc 14 eng))
      ang (+ (/ pi 2) (angle pt1 pt2))
      pt3 (polar pt1 ang dis)
      eng (subst (cons 10 pt3) (assoc 10 eng) eng)
    )
    (entmod eng)
  )
  (princ)
)

(defun c:rvd (/ ss i eng pt1 pt2 pt3 pt4)
  (setq ss (ssget '((0 . "DIMENSION"))) i (sslength ss))
  (repeat i
    (setq 
      i (1- i)
      eng (entget (ssname ss i))
      pt1 (cdr (assoc 13 eng))
      pt3 (cdr (assoc 10 eng))
      pt3 (polar pt3 (angle pt3 pt1 ) (* 2 (distance pt1 pt3)))
      eng (subst (cons 10 pt3) (assoc 10 eng) eng)
    )
    (entmod eng)
  )
  (princ)
)

     

    • Like 1

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

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

     Dạ, vì bản vẽ quy hoạch có hàng chục ngàn dim nên chọn từng dim thì ko khác gì làm lại rồi anh. Hoặc tối thiểu cũng phải chọn được từng cụm một offset ra ạ, hoặc như kiểu lệnh offset hàng loạt là chọn giá trị - hoặc + vậy ạ 

      

    Mình nghĩ ra 1 phương pháp đơn giản nhất với 2 lệnh

    1 lệnh chọn tất cả dim: tách text dim và dim 1 khoảng cho trước không cần biết đúng sai.

    lệnh thứ 2 bạn chọn những dim bị sai và lisp sẽ reverse lại. đợi mình nghiên cứu code rồi sẽ quay lại

    • Like 1

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

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

    Cũng ko hẳn anh, cái của anh là dim mới, còn cái em cần tìm là biến những phần dim sẵn chân dim trùng với đỉnh dim sẽ thành dim có chân dim giữ nguyên và đỉnh dim có khoảng cách theo ý mình ạ!

      

    Điều quan trọng là bạn muốn text dim ở vị trí nào so với dim (trên dưới trái phải). nếu chọn từng dim và pick hướng như lệnh offset thì dễ. nhưng nếu bạn chọn tất cả trong bản vẽ thì điều này gần như bất khả thi.

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

    nếu đường thẳng của bạn chỉ nằm ngang thì dùng lisp này của mình nhé. 

    quét chọn nhiều đối tượng trước rồi chọn mẫu sau. 

    (defun c:test (/ ss ent block scl drpt)
  (setq 
    ss (mapcar 
         '(lambda (x) (cadr (assoc 10 (entget x))))
         (acet-ss-to-list (ssget '((0 . "INSERT"))))
       )
    ent (entget (car (entsel "\nSelect model:")))
    block (cdr (assoc 2 ent))
    drpt (cddr (assoc 10 ent))
    scl (abs (cdr (assoc 41 ent)))
  )
  (foreach item ss
    (entmake (list
	    (cons 0 "INSERT")
	    (cons 100 "AcDbEntity")
	    (cons 100 "AcDbBlockReference")
	    (cons 2 block)
	    (append (list 10 item) drpt)
	    (cons 41 scl)
	    (cons 42 scl)
	    (cons 43 scl)
	  ))
  )
  (princ)
)

     

    • Like 2

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

    Mình thích dùng entmake hơn bạn tạo sẵn 1 lần layer rồi entget để lấy thông số. lưu thành lisp để entmake đối tượng đó:

    ví dụ như thế này: 

        (entmake 
     '(  (0 . "DIMSTYLE") (100 . "AcDbSymbolTableRecord")
         (100 . "AcDbDimStyleTableRecord")
         (2 . "DIM CHIALO LISP") (70 . 0)
         (3 . "") (4 . "") (5 . "Dot") (6 . "") (7 . "")
         (40 . 1.0) (41 . 0.1) (42 . 0.2) (43 . 0.3) (44 . 0.2) (45 . 0.0) (46 . 0.0) (47 . 0.0) (48 . 0.0) 
         (140 . 1.15) (141 . 0.3) (142 . 0.0) (143 . 25.4) (144 . 1.0) (145 . 0.0) (146 . 1.0) (147 . 0.3) 
         (71 . 0) (72 . 0) (73 . 0) (74 . 0) (75 . 1) (76 . 1) (77 . 1) (78 . 0) 
         (170 . 0) (171 . 2) (172 . 0) (173 . 0) (174 . 0) (175 . 0) (176 . 160) (177 . 160) (178 . 252) 
         (270 . 2) (271 . 2) (272 . 2) (273 . 2) (274 . 2) (275 . 0)
         (280 . 0) (281 . 1) (282 . 1) (283 . 1) (284 . 0) (285 . 0) (286 . 0) (287 . 4) (288 . 0)
       )
    )

     

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

    8 phút trước, Doan Van Ha đã nói:

    Bản chất Cad đã có bộ OK_Cancel và đương nhiên nhấn enter thì chạy và cancel thì hủy nên bạn không cần tạo bộ OK_Cancel nữa

    Em biết vụ này nhưng để lấy danh sách (list input) sẽ khó khăn hơn khi dùng bộ OK_Cancel;

    ;người dùng có thể nhập nhiều lần 1 box. action_tile "Item" chạy nhiều lần.

    Em vẫn đang thắc mắc vấn đề khi sửa dữ liệu ---- nhấn ENTER từ bàn phím thì không tiếp tục chạy lisp cần phải kích chuột mới chạy chương trình. 

     

  14. Đã đăng · Chỉnh sửa theo tannguyen291
    Cập nhật tính năng enter từ bàn phím.     · Trả lời báo cáo

     

     

     

    Hi. Gần đây em đang viết 1 lisp cần hộp thoại nhập nhiều nội dung, nên tiện thể share cho anh em cùng dùng. 

    Nhân đây em cũng muốn hỏi các cao nhân làm sao để nhập ENTER từ bàn phím thì trực tiếp chạy.    ;;;;;;;;;;;;;;;Em đã tìm đc phương pháp cho vấn đề này

    Các bác giúp đỡ em vụ này với. ;;;;;TKS bác Doan Van Ha đã hỗ trợ rất nhiệt tình.

    image.png.e0059dccbc46a259be64f9327431746b.png 

    ;; DiagBox list edit box 
;; Được viết bởi Nguyễn Nhật Tân
;; nguyennhattanpt@gmail.com 

(defun c:test (/ lstbox)
  (setq lstbox '(("Box1" . "item1") ("Box2" . "item2")("Box3" . "item3")("Box4" . "item4")))
  (tan:actioninputlstbox lstbox '(1))
)

(defun tan:actioninputlstbox ( lst lstlock / *error* str dcl_id UserClick x1 x2 i lstin des)
  (defun *error* (msg)
    (done_dialog)
    (vl-file-delete Fdcl)
  )
  (setq i 0 str "ListEditBox : dialog {label = \"Insert Data.\";\n")
  (foreach item (mapcar 'car lst)
    (setq str (strcat 
      str 
      "  : edit_box {\n"
      "    label = \"" item "\";\n"
      "    key = \"Item"  (itoa i) "\";\n"
      "    edit_width = 12;\n"
      "    allow_accept = true;"
      "  }\n"
              )
    )
    (setq i (1+ i))
  )
  (setq str (strcat str 
    "  : row {: spacer { width = 1; }\n"        
    "    : button {label = \"OK\"; is_default = true; key = \"accept\"; width = 8; fixed_width = true;}\n" 
    "    : button {label = \"Cancel\"; is_default = false; is_cancel = true;key = \"cancel\";width = 8;fixed_width = true;}"
    "    : spacer { width = 1;}\n  }\n"
    "}"                
            )
  )
  (setq Fdcl (vl-filename-mktemp "dcllsteditbox.dcl"))
  (setq des (open Fdcl "w"))
  (write-line str des)
  (close des)
  (cond
    ((>= 0 (setq dcl_id (load_dialog Fdcl)))
      (princ "\n--> Dialog Definition not Found.")
    )
    ( (not (new_dialog "ListEditBox" dcl_id))
      (setq dcl_id (unload_dialog dcl_id))
      (princ "\n--> Dialog Definition not Found.")
    )
    (t
      (setq i 0)
      (foreach item (mapcar 'cdr  lst)
        (set_tile (strcat "Item" (itoa i) ) (if item item ""))
        (setq i (1+ i))
      )
      (foreach item lstlock
        (mode_tile (strcat "Item" (itoa item)) 1)
      )
      (action_tile "cancel" "(progn (setq UserClick nil) (done_dialog))")
      (action_tile "accept" 
                   "(progn (setq UserClick T)\n
                      (repeat (setq i (length lst))\n
                        (setq i (1- i) lstin (cons (get_tile (strcat \"Item\" (itoa i))) lstin)))\n
                      (done_dialog))"
      )
      (start_dialog)
    )
  )
  (vl-file-delete Fdcl)
  (if UserClick
    (mapcar '(lambda (a b) (cons (car a) b)) lst lstin)
    nil
  )
)

     

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

    Của bạn đây nhé!

    Vì bạn dùng nhiều loại BLOCK att nên mình bỏ chức năng chọn att. mọi att đều xuất ra. 

      

    (defun c:QT (/ ss tag file_name lstbkatt lstpt file_write item ent lstatt pair str)
  (setq 
    ss (acet-ss-to-list (ssget '((0 . "INSERT"))))
    file_name (getfiled "Xuat du lieu" "Thong ke Toa do" "txt" 1)
  )
  (mapcar
    '(lambda (x) 
      (if (assoc 66 (entget x))
        (setq lstbkatt (cons x lstbkatt))
        (setq lstpt (cons (cdr (assoc 10 (entget x))) lstpt))
      )
     )
    ss
  )
  (if (and file_name (= (length lstbkatt) (length lstpt)))
    (progn
      (setq file_write (open file_name "W"))
      (foreach item lstpt
        (setq 
          ent (car (vl-sort lstbkatt '(lambda (a b) (< (distance item (cdr (assoc 10 (ENTGET a)))) (distance item (cdr (assoc 10 (ENTGET b))))))))
          str (strcat (cdr (assoc 2 (entget ent))) "\t" (rtos (Car item) 2 4) "\t" (rtos (Cadr item) 2 4))
          lstatt (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
        )
        (foreach pair lstatt
          (setq str (strcat str "\t" (vla-get-textstring pair)))
        )
        (write-line str file_write)
      )
      (close file_write)
    )
    (alert "\nNot match data!")
  )
  (princ)
)

     

    • Like 1

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

    Minh viết hơi vội nên không để ý lỗi cú pháp bạn chạy lại cái này hoặc gửi file cad mình chạy thử xem sao 

    (defun c:QT (/ ss tag file_name lstbkatt lstpt file_write item ent lstatt pair str)
  (setq 
    ss (acet-ss-to-list (ssget '((0 . "INSERT"))))
    tag (nentsel "\nSelect Att:")
    file_name (getfiled "Xuat du lieu" "Thong ke Toa do" "txt" 1)
  )
  (mapcar
    '(lambda (x) 
      (if (assoc 66 (entget x))
        (setq lstbkatt (cons x lstbkatt))
        (setq lstpt (cons (cdr (assoc 10 (entget x))) lstpt)) ;<===== sai chỗ này nè. :))
      )
     )
    ss
  )
  (if (and tag file_name (= (length lstbkatt) (length lstpt)))
    (setq file_write (open file_name "W"))
    (exit)
  )
  (setq tag (strcase (cdr (assoc 2 (entget (car tag))))))
  (foreach item lstpt
    (setq 
      str (strcat (rtos (Car item) 2 4) "\t" (rtos (Cadr item) 2 4))
      ent (car (vl-sort lstbkatt '(lambda (a b) (< (distance item (cdr (assoc 10 (ENTGET a)))) (distance item (cdr (assoc 10 (ENTGET b))))))))
      lstatt (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
    )
    (foreach pair lstatt
      (if (= tag (strcase (vla-get-tagstring pair)))
       (setq str (strcat str "\t" (vla-get-textstring pair)))
      )
    )
    (write-line str file_write)
  )
  (close file_write)
  (princ)
)

     

    • Like 1

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

    Mình nhận thấy thuật toán này cũng không khó lắm. 

    1.  Chọn block và BLOCKATT

    2. chọn att để lấy tagstring (dùng nentsel hoặc getword đều được)

    3. Lọc Block và text thành 2 list (điều kiện cần: độ dài 2 list này bằng nhau)

    4. Tạo danh sách điểm Block

    5. ứng với mỗi điểm Lấy 1 BLOCKATT ở gần nhất (so sánh tagstring  att trong block để lấy text tring.)

    done!

      

    (defun c:QT (/ ss tag file_name lstbkatt lstpt file_write item ent lstatt pair str)
  (setq 
    ss (acet-ss-to-list (ssget '((0 . "INSERT"))))
    tag (nentsel "\nSelect Att:")
    file_name (getfiled "Xuat du lieu" "Thong ke Toa do" "txt" 1)
  )
  (mapcar
    '(lambda (x) 
      (if (assoc 66 (entget x))
        (setq lstbkatt (cons x lstbkatt))
        (setq lstpt (cons (cdr (assoc 10 (entget x)))))
      )
     )
    ss
  )
  (if (and tag file_name (= (length lstbkatt) (length lstpt)))
    (setq file_write (open file_name "W"))
    (exit)
  )
  (setq tag (strcase (cdr (assoc 2 (entget (car tag))))))
  (foreach item lstpt
    (setq 
      str (strcat (rtos (Car item) 2 4) "\t" (rtos (Cadr item) 2 4))
      ent (car (vl-sort lstbkatt '(lambda (a b) (< (distance item (cdr (assoc 10 (ENTGET a)))) (distance item (cdr (assoc 10 (ENTGET b))))))))
      lstatt (vlax-invoke (vlax-ename->vla-object ent) 'getattributes)
    )
    (foreach pair lstatt
      (if (= tag (strcase (vla-get-tagstring pair)))
       (setq str (strcat str "\t" (vla-get-textstring pair)))
      )
    )
    (write-line str file_write)
  )
  (close file_write)
  (princ)
)

     

     

     

     

×