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

    446

  • Đã tham gia

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

  • Ngày trúng

    42

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

  4. Đã đă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

  7. Đã đă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)
       )
    )

     

  10. Đã đă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. 

     

  11. Đã đă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
  )
)

     

  19. Đã đă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

  20. Đã đă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

  21. Đã đă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)
)

     

     

     

     

×