Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Tháng 10 14, 2020

2 giờ trước, Doan Nguyen Van đã nói:

Bạn dùng trong trường hợp nào? dấu \ trong lisp gồm 2 ký tự, nên bạn đổi như vậy là vô nghĩa

Để mình dùng lệnh open. Mình thấy link \\ không mở được bản vẽ.

Tháng 10 14, 2020

2 giờ trước, ngokiet đã nói:

Cái "C:\\test1\\test2\\test3" thì Cad hiểu là cái dưới

Còn cái "C:\test1\test2\test3" thì cad hiều /t là tab ascii là 9

Vì vậy

(LM:StringSubst "\t" "\\t" "C:\\test1\\test2\\test3")

Cảm ơn bác. \\Test là trường hợp ví dụ. Không có tổng quát thấy thế à bác.

Tháng 10 14, 2020

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

Để mình dùng lệnh open. Mình thấy link \\ không mở được bản vẽ.

Thường thì vẫn mở được, nhưng bạn thử đổi \\ thành / xem. Dấu này tương tự

Tháng 10 14, 2020

1 giờ} trướ}c, Doan Nguyen Van đã nói:

Thường thì vẫn mở được, nhưng bạn thử đổi \\ thành / xem. Dấu này tương tự

Chào anh! Em sv xd thấy mấy anh viết lisp hay quá nên cũng tập viết anh giúp em đoạn code này được không ạ.

Em có ảnh như dưới:

VD: em có 3 lớp dim(có thể nhiều hơn) anh giúp em cái lisp quét qua 1 lần 3 lớp dim đó lớp dim nào được chọn đầu tiên sẽ được làm chuẩn và lớp dim còn lại giãn ra theo một khoảng nhất định( còn bao nhiêu hay nhập vào khoảng cách bao nhiêu thì em viết được)

enter tiếp để thực hiện lại lệnh esc để thoát lệnh.

Mong anh giúp!

Tháng 10 14, 2020

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

Chào anh! Em sv xd thấy mấy anh viết lisp hay quá nên cũng tập viết anh giúp em đoạn code này được không ạ.

Em có ảnh như dưới:

VD: em có 3 lớp dim(có thể nhiều hơn) anh giúp em cái lisp quét qua 1 lần 3 lớp dim đó lớp dim nào được chọn đầu tiên sẽ được làm chuẩn và lớp dim còn lại giãn ra theo một khoảng nhất định( còn bao nhiêu hay nhập vào khoảng cách bao nhiêu thì em viết được)

enter tiếp để thực hiện lại lệnh esc để thoát lệnh.

Mong anh giúp!

Cái này của sếp @ketxu đã làm rồi, bạn liên hệ a ấy nhé

Tháng 10 15, 2020

1 giờ} trướ}c, Doan Nguyen Van đã nói:

Cái này của sếp @ketxu đã làm rồi, bạn liên hệ a ấy nhé

Thanks a! Để em tìm a ấy!

Tháng 10 15, 2020

12 giờ trước, Doan Nguyen Van đã nói:

Thường thì vẫn mở được, nhưng bạn thử đổi \\ thành / xem. Dấu này tương tự

Không được bạn ơi. Mình dùng hàm này để lấy đường dẫn file bản vẽ:

;;------------------------=={ Get Files Dialog }==----------------------;;
;;                                                                      ;;
;;  An analog of the 'getfiled' function for multiple file selection.   ;;
;;----------------------------------------------------------------------;;
;;  Author:  Lee Mac, Copyright © 2012  -  www.lee-mac.com              ;;
;;----------------------------------------------------------------------;;
;;  Arguments:                                                          ;;
;;  msg - [str/nil] Dialog box label; 'Select Files' if nil or "".      ;;
;;  def - [str/nil] Default directory; dwgprefix if nil or "".          ;;
;;  ext - [str/nil] File extension filter (e.g. "dwg;lsp"); "*" if nil  ;;
;;----------------------------------------------------------------------;;
;;  Returns:  List of selected files, else nil                          ;;
;;----------------------------------------------------------------------;;
;;  Version 1.6    -    2016-03-21                                      ;;
;;----------------------------------------------------------------------;;

(defun LM:getfiles ( msg def ext / *error* dch dcl des dir dirdata lst rtn )

    (defun *error* ( msg )
        (if (= 'file (type des))
            (close des)
        )
        (if (and (= 'int (type dch)) (< 0 dch))
            (unload_dialog dch)
        )
        (if (and (= 'str (type dcl)) (findfile dcl))
            (vl-file-delete dcl)
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )   
    
    (if
        (and
            (setq dcl (vl-filename-mktemp nil nil ".dcl"))
            (setq des (open dcl "w"))
            (progn
                (foreach x
                   '(
                        "lst : list_box"
                        "{"
                        "    width = 40.0;"
                        "    height = 20.0;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "    multiple_select = true;"
                        "}"
                        "but : button"
                        "{"
                        "    width = 20.0;"
                        "    height = 1.8;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "}"
                        "getfiles : dialog"
                        "{"
                        "    key = \"title\"; spacer;"
                        "    : row"
                        "    {"
                        "        alignment = centered;"
                        "        : edit_box { key = \"dir\"; label = \"Folder:\"; }"
                        "        : button"
                        "        {"
                        "            key = \"brw\";"
                        "            label = \"Browse\";"
                        "            fixed_width = true;"
                        "        }"
                        "    }"
                        "    spacer;"
                        "    : row"
                        "    {"
                        "        : column"
                        "        {"
                        "            : lst { key = \"box1\"; }"
                        "            : but { key = \"add\" ; label = \"Add Files\"; }"
                        "        }"
                        "        : column {"
                        "            : lst { key = \"box2\"; }"
                        "            : but { key = \"del\" ; label = \"Remove Files\"; }"
                        "        }"
                        "    }"
                        "    spacer; ok_cancel;"
                        "}"
                    )
                    (write-line x des)
                )
                (setq des (close des))
                (< 0 (setq dch (load_dialog dcl)))
            )
            (new_dialog "getfiles" dch)
        )
        (progn
            (setq ext (if (= 'str (type ext)) (LM:getfiles:str->lst (strcase ext) ";") '("*")))
            (set_tile "title" (if (member msg '(nil "")) "Select Files" msg))
            (set_tile "dir"
                (setq dir
                    (LM:getfiles:fixdir
                        (if (or (member def '(nil "")) (not (vl-file-directory-p (LM:getfiles:fixdir def))))
                            (getvar 'dwgprefix)
                            def
                        )
                    )
                )
            )
            (setq lst (LM:getfiles:updatefilelist dir ext nil))
            (mode_tile "add" 1)
            (mode_tile "del" 1)

            (action_tile "brw"
                (vl-prin1-to-string
                   '(if (setq tmp (LM:getfiles:browseforfolder "" nil 512))
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )                              
                    )
                )
            )

            (action_tile "dir"
                (vl-prin1-to-string
                   '(if (= 1 $reason)
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:fixdir $value))) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )
                    )
                )
            )

            (action_tile "box1"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm tmp )
                            (if (setq itm (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" $value ")"))))
                                (if (= 4 $reason)
                                    (cond
                                        (   (equal '("..") itm)
                                            (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:updir dir))) ext rtn)
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                            )
                                        )
                                        (   (vl-file-directory-p (setq tmp (LM:getfiles:checkredirect (strcat dir "\\" (car itm)))))
                                            (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                            )
                                        )
                                        (   (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "\\" x)) itm)))
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                                  lst (LM:getfiles:updatefilelist dir ext rtn)
                                            )
                                        )
                                    )
                                    (if (vl-every '(lambda ( x ) (vl-file-directory-p (strcat dir "\\" x))) itm)
                                        (mode_tile "add" 1)
                                        (mode_tile "add" 0)
                                    )
                                )
                            )
                        )
                    )
                )
            )

            (action_tile "box2"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm (mapcar '(lambda ( n ) (nth n rtn)) (read (strcat "(" $value ")"))))
                                (if (= 4 $reason)
                                    (setq rtn (LM:getfiles:updateselected dir (vl-remove (car itm) rtn))
                                          lst (LM:getfiles:updatefilelist dir ext rtn)
                                    )
                                    (mode_tile "del" 0)
                                )
                            )
                        )
                    )
                )
            )

            (action_tile "add"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if
                                (setq itm
                                    (vl-remove-if 'vl-file-directory-p
                                        (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" (get_tile "box1") ")")))
                                    )
                                )
                                (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "\\" x)) itm)))
                                      rtn (LM:getfiles:updateselected dir rtn)
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )

            (action_tile "del"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm (read (strcat "(" (get_tile "box2") ")")))
                                (setq rtn (LM:getfiles:updateselected dir (LM:getfiles:removeitems itm rtn))
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "add" 1)
                            (mode_tile "del" 1)
                        )
                    )
                )
            )
         
            (if (zerop (start_dialog))
                (setq rtn nil)
            )
        )
    )
    (*error* nil)
    rtn
)

(defun LM:getfiles:listbox ( key lst )
    (start_list key)
    (foreach x lst (add_list x))
    (end_list)
    lst
)

(defun LM:getfiles:listfiles ( dir ext lst )
    (vl-remove-if '(lambda ( x ) (member (strcat dir "\\" x) lst))
        (cond
            (   (cdr (assoc dir dirdata)))
            (   (cdar
                    (setq dirdata
                        (cons
                            (cons dir
                                (append
                                    (LM:getfiles:sortlist (vl-remove "." (vl-directory-files dir nil -1)))
                                    (LM:getfiles:sort
                                        (if (member ext '(("") ("*")))
                                            (vl-directory-files dir nil 1)
                                            (vl-remove-if-not
                                                (function
                                                    (lambda ( x / e )
                                                        (and
                                                            (setq e (vl-filename-extension x))
                                                            (setq e (strcase (substr e 2)))
                                                            (vl-some '(lambda ( w ) (wcmatch e w)) ext)
                                                        )
                                                    )
                                                )
                                                (vl-directory-files dir nil 1)
                                            )
                                        )
                                    )
                                )
                            )
                            dirdata
                        )
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:checkredirect ( dir / itm pos )
    (cond
        (   (vl-directory-files dir) dir)
        (   (and
                (=  (strcase (getenv "UserProfile"))
                    (strcase (substr dir 1 (setq pos (vl-string-position 92 dir nil t))))
                )
                (setq itm
                    (cdr
                        (assoc (substr (strcase dir t) (+ pos 2))
                           '(
                                ("my documents" . "Documents")
                                ("my pictures"  . "Pictures")
                                ("my videos"    . "Videos")
                                ("my music"     . "Music")
                            )
                        )
                    )
                )
                (vl-file-directory-p (setq itm (strcat (substr dir 1 pos) "\\" itm)))
            )
            itm
        )
        (   dir   )
    )
)

(defun LM:getfiles:sort ( lst )
    (apply 'append
        (mapcar 'LM:getfiles:sortlist
            (vl-sort
                (LM:getfiles:groupbyfunction lst
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension a))
                            (setq y (vl-filename-extension b))
                            (= (strcase x) (strcase y))
                        )
                    )
                )
                (function
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension (car a)))
                            (setq y (vl-filename-extension (car b)))
                            (< (strcase x) (strcase y))
                        )
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:sortlist ( lst )
    (mapcar (function (lambda ( n ) (nth n lst)))
        (vl-sort-i (mapcar 'LM:getfiles:splitstring lst)
            (function
                (lambda ( a b / x y )
                    (while
                        (and
                            (setq x (car a))
                            (setq y (car b))
                            (= x y)
                        )
                        (setq a (cdr a)
                              b (cdr b)
                        )
                    )
                    (cond
                        (   (null x) b)
                        (   (null y) nil)
                        (   (and (numberp x) (numberp y)) (< x y))
                        (   (numberp x))
                        (   (numberp y) nil)
                        (   (< x y))
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:groupbyfunction ( lst fun / tmp1 tmp2 x1 )
    (if (setq x1 (car lst))
        (progn
            (foreach x2 (cdr lst)
                (if (fun x1 x2)
                    (setq tmp1 (cons x2 tmp1))
                    (setq tmp2 (cons x2 tmp2))
                )
            )
            (cons (cons x1 (reverse tmp1)) (LM:getfiles:groupbyfunction (reverse tmp2) fun))
        )
    )
)

(defun LM:getfiles:splitstring ( str )
    (
        (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (apply 'append
                            (mapcar
                                (function
                                    (lambda ( a b c )
                                        (cond
                                            (   (member b '(45 46 92))
                                                (list 32)
                                            )
                                            (   (< 47 b 58)
                                                (list b)
                                            )
                                            (   (list 32 34 b 34 32))
                                        )
                                    )
                                )
                                (cons nil l) l (append (cdr l) '(( )))
                            )
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list (strcase str))
    )
)

(defun LM:getfiles:browseforfolder ( msg dir flg / err fld pth shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "shell.application")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg flg dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (LM:getfiles:fixdir (vlax-get-property slf 'path))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    )
)

(defun LM:getfiles:full->relative ( dir path / p q )
    (setq dir (vl-string-right-trim "\\" dir))
    (cond
        (   (and
                (setq p (vl-string-position 58  dir))
                (setq q (vl-string-position 58 path))
                (/= (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
            )
            path
        )
        (   (and
                (setq p (vl-string-position 92  dir))
                (setq q (vl-string-position 92 path))
                (= (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
            )
            (LM:getfiles:full->relative (substr dir (+ 2 p)) (substr path (+ 2 q)))
        )
        (   (and
                (setq q (vl-string-position 92 path))
                (= (strcase dir) (strcase (substr path 1 q)))
            )
            (strcat ".\\" (substr path (+ 2 q)))
        )
        (   (= "" dir)
            path
        )
        (   (setq p (vl-string-position 92 dir))
            (LM:getfiles:full->relative (substr dir (+ 2 p)) (strcat "..\\" path))
        )
        (   (LM:getfiles:full->relative "" (strcat "..\\" path)))
    )
)

(defun LM:getfiles:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:getfiles:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

(defun LM:getfiles:updatefilelist ( dir ext lst )
    (LM:getfiles:listbox "box1" (LM:getfiles:listfiles dir ext lst))
)

(defun LM:getfiles:updateselected ( dir lst )
    (LM:getfiles:listbox "box2" (mapcar '(lambda ( x ) (LM:getfiles:full->relative dir x)) lst))
    lst
)

(defun LM:getfiles:updir ( dir )
    (substr dir 1 (vl-string-position 92 dir nil t))
)

(defun LM:getfiles:fixdir ( dir )
    (vl-string-right-trim "\\" (vl-string-translate "/" "\\" dir))
)

(defun LM:getfiles:removeitems ( itm lst / idx )
    (setq idx -1)
    (vl-remove-if '(lambda ( x ) (member (setq idx (1+ idx)) itm)) lst)
)

Sau đó nó ra 1 list các đường dẫn dạng "...//Myfoder1//Drawing1.dwg" ấy. Dùng open thì không mở được file. Không biết phải xử lý đường dẫn sao để mở được file bạn nhỉ?

Tháng 10 15, 2020

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

Không được bạn ơi. Mình dùng hàm này để lấy đường dẫn file bản vẽ:

cadvietlisp.lsp
[✎]


;;------------------------=={ Get Files Dialog }==----------------------;;
;                                                                      ;;
;  An analog of the 'getfiled' function for multiple file selection.   ;;
;----------------------------------------------------------------------;;
;  Author:  Lee Mac, Copyright © 2012  -  www.lee-mac.com              ;;
;----------------------------------------------------------------------;;
;  Arguments:                                                          ;;
;  msg - [str/nil] Dialog box label; 'Select Files' if nil or "".      ;;
;  def - [str/nil] Default directory; dwgprefix if nil or "".          ;;
;  ext - [str/nil] File extension filter (e.g. "dwg;lsp"); "*" if nil  ;;
;----------------------------------------------------------------------;;
;  Returns:  List of selected files, else nil                          ;;
;----------------------------------------------------------------------;;
;  Version 1.6    -    2016-03-21                                      ;;
;----------------------------------------------------------------------;;

(defun LM:getfiles ( msg def ext / *error* dch dcl des dir dirdata lst rtn )

    (defun *error* ( msg )
        (if (= 'file (type des))
            (close des)
        )
        (if (and (= 'int (type dch)) (< 0 dch))
            (unload_dialog dch)
        )
        (if (and (= 'str (type dcl)) (findfile dcl))
            (vl-file-delete dcl)
        )
        (if (and msg (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*")))
            (princ (strcat "\nError: " msg))
        )
        (princ)
    )   
    
    (if
        (and
            (setq dcl (vl-filename-mktemp nil nil ".dcl"))
            (setq des (open dcl "w"))
            (progn
                (foreach x
                   '(
                        "lst : list_box"
                        "{"
                        "    width = 40.0;"
                        "    height = 20.0;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "    multiple_select = true;"
                        "}"
                        "but : button"
                        "{"
                        "    width = 20.0;"
                        "    height = 1.8;"
                        "    fixed_width = true;"
                        "    fixed_height = true;"
                        "    alignment = centered;"
                        "}"
                        "getfiles : dialog"
                        "{"
                        "    key = \"title\"; spacer;"
                        "    : row"
                        "    {"
                        "        alignment = centered;"
                        "        : edit_box { key = \"dir\"; label = \"Folder:\"; }"
                        "        : button"
                        "        {"
                        "            key = \"brw\";"
                        "            label = \"Browse\";"
                        "            fixed_width = true;"
                        "        }"
                        "    }"
                        "    spacer;"
                        "    : row"
                        "    {"
                        "        : column"
                        "        {"
                        "            : lst { key = \"box1\"; }"
                        "            : but { key = \"add\" ; label = \"Add Files\"; }"
                        "        }"
                        "        : column {"
                        "            : lst { key = \"box2\"; }"
                        "            : but { key = \"del\" ; label = \"Remove Files\"; }"
                        "        }"
                        "    }"
                        "    spacer; ok_cancel;"
                        "}"
                    )
                    (write-line x des)
                )
                (setq des (close des))
                (< 0 (setq dch (load_dialog dcl)))
            )
            (new_dialog "getfiles" dch)
        )
        (progn
            (setq ext (if (= 'str (type ext)) (LM:getfiles:str->lst (strcase ext) ";") '("*")))
            (set_tile "title" (if (member msg '(nil "")) "Select Files" msg))
            (set_tile "dir"
                (setq dir
                    (LM:getfiles:fixdir
                        (if (or (member def '(nil "")) (not (vl-file-directory-p (LM:getfiles:fixdir def))))
                            (getvar 'dwgprefix)
                            def
                        )
                    )
                )
            )
            (setq lst (LM:getfiles:updatefilelist dir ext nil))
            (mode_tile "add" 1)
            (mode_tile "del" 1)

            (action_tile "brw"
                (vl-prin1-to-string
                   '(if (setq tmp (LM:getfiles:browseforfolder "" nil 512))
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir tmp)) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )                              
                    )
                )
            )

            (action_tile "dir"
                (vl-prin1-to-string
                   '(if (= 1 $reason)
                        (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:fixdir $value))) ext rtn)
                              rtn (LM:getfiles:updateselected dir rtn)
                        )
                    )
                )
            )

            (action_tile "box1"
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm tmp )
                            (if (setq itm (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" $value ")"))))
                                (if (= 4 $reason)
                                    (cond
                                        (   (equal '("..") itm)
                                            (setq lst (LM:getfiles:updatefilelist (set_tile "dir" (setq dir (LM:getfiles:updir dir))) ext rtn)
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                            )
                                        )
                                        (   (vl-file-directory-p (setq tmp (LM:getfiles:checkredirect (strcat dir "\\" (car itm)))))
                                            (setq lst (LM:getfiles:updatefilelist (set_tile "" (setq dir tmp)) ext rtn)
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                            )
                                        )
                                        (   (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "" x)) itm)))
                                                  rtn (LM:getfiles:updateselected dir rtn)
                                                  lst (LM:getfiles:updatefilelist dir ext rtn)
                                            )
                                        )
                                    )
                                    (if (vl-every '(lambda ( x ) (vl-file-directory-p (strcat dir "" x))) itm)
                                        (mode_tile "" 1)
                                        (mode_tile "" 0)
                                    )
                                )
                            )
                        )
                    )
                )
            )

            (action_tile ""
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm (mapcar '(lambda ( n ) (nth n rtn)) (read (strcat "(" $value ")"))))
                                (if (= 4 $reason)
                                    (setq rtn (LM:getfiles:updateselected dir (vl-remove (car itm) rtn))
                                          lst (LM:getfiles:updatefilelist dir ext rtn)
                                    )
                                    (mode_tile "" 0)
                                )
                            )
                        )
                    )
                )
            )

            (action_tile ""
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if
                                (setq itm
                                    (vl-remove-if 'vl-file-directory-p
                                        (mapcar '(lambda ( n ) (nth n lst)) (read (strcat "(" (get_tile "") ")")))
                                    )
                                )
                                (setq rtn (LM:getfiles:sort (append rtn (mapcar '(lambda ( x ) (strcat dir "" x)) itm)))
                                      rtn (LM:getfiles:updateselected dir rtn)
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "" 1)
                            (mode_tile "" 1)
                        )
                    )
                )
            )

            (action_tile ""
                (vl-prin1-to-string
                   '(
                        (lambda ( / itm )
                            (if (setq itm (read (strcat "(" (get_tile "") ")")))
                                (setq rtn (LM:getfiles:updateselected dir (LM:getfiles:removeitems itm rtn))
                                      lst (LM:getfiles:updatefilelist dir ext rtn)
                                )
                            )
                            (mode_tile "" 1)
                            (mode_tile "" 1)
                        )
                    )
                )
            )
         
            (if (zerop (start_dialog))
                (setq rtn nil)
            )
        )
    )
    (*error* nil)
    rtn
)

(defun LM:getfiles:listbox ( key lst )
    (start_list key)
    (foreach x lst (add_list x))
    (end_list)
    lst
)

(defun LM:getfiles:listfiles ( dir ext lst )
    (vl-remove-if '(lambda ( x ) (member (strcat dir "" x) lst))
        (cond
            (   (cdr (assoc dir dirdata)))
            (   (cdar
                    (setq dirdata
                        (cons
                            (cons dir
                                (append
                                    (LM:getfiles:sortlist (vl-remove "" (vl-directory-files dir nil -1)))
                                    (LM:getfiles:sort
                                        (if (member ext '(("") ("*")))
                                            (vl-directory-files dir nil 1)
                                            (vl-remove-if-not
                                                (function
                                                    (lambda ( x / e )
                                                        (and
                                                            (setq e (vl-filename-extension x))
                                                            (setq e (strcase (substr e 2)))
                                                            (vl-some '(lambda ( w ) (wcmatch e w)) ext)
                                                        )
                                                    )
                                                )
                                                (vl-directory-files dir nil 1)
                                            )
                                        )
                                    )
                                )
                            )
                            dirdata
                        )
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:checkredirect ( dir / itm pos )
    (cond
        (   (vl-directory-files dir) dir)
        (   (and
                (=  (strcase (getenv "UserProfile"))
                    (strcase (substr dir 1 (setq pos (vl-string-position 92 dir nil t))))
                )
                (setq itm
                    (cdr
                        (assoc (substr (strcase dir t) (+ pos 2))
                           '(
                                ("my documents" . "Documents")
                                ("my pictures"  . "Pictures")
                                ("my videos"    . "Videos")
                                ("my music"     . "Music")
                            )
                        )
                    )
                )
                (vl-file-directory-p (setq itm (strcat (substr dir 1 pos) "\\" itm)))
            )
            itm
        )
        (   dir   )
    )
)

(defun LM:getfiles:sort ( lst )
    (apply 'append
        (mapcar 'LM:getfiles:sortlist
            (vl-sort
                (LM:getfiles:groupbyfunction lst
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension a))
                            (setq y (vl-filename-extension b))
                            (= (strcase x) (strcase y))
                        )
                    )
                )
                (function
                    (lambda ( a b / x y )
                        (and
                            (setq x (vl-filename-extension (car a)))
                            (setq y (vl-filename-extension (car b)))
                            (< (strcase x) (strcase y))
                        )
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:sortlist ( lst )
    (mapcar (function (lambda ( n ) (nth n lst)))
        (vl-sort-i (mapcar 'LM:getfiles:splitstring lst)
            (function
                (lambda ( a b / x y )
                    (while
                        (and
                            (setq x (car a))
                            (setq y (car b))
                            (= x y)
                        )
                        (setq a (cdr a)
                              b (cdr b)
                        )
                    )
                    (cond
                        (   (null x) b)
                        (   (null y) nil)
                        (   (and (numberp x) (numberp y)) (< x y))
                        (   (numberp x))
                        (   (numberp y) nil)
                        (   (< x y))
                    )
                )
            )
        )
    )
)

(defun LM:getfiles:groupbyfunction ( lst fun / tmp1 tmp2 x1 )
    (if (setq x1 (car lst))
        (progn
            (foreach x2 (cdr lst)
                (if (fun x1 x2)
                    (setq tmp1 (cons x2 tmp1))
                    (setq tmp2 (cons x2 tmp2))
                )
            )
            (cons (cons x1 (reverse tmp1)) (LM:getfiles:groupbyfunction (reverse tmp2) fun))
        )
    )
)

(defun LM:getfiles:splitstring ( str )
    (
        (lambda ( l )
            (read
                (strcat "("
                    (vl-list->string
                        (apply 'append
                            (mapcar
                                (function
                                    (lambda ( a b c )
                                        (cond
                                            (   (member b '(45 46 92))
                                                (list 32)
                                            )
                                            (   (< 47 b 58)
                                                (list b)
                                            )
                                            (   (list 32 34 b 34 32))
                                        )
                                    )
                                )
                                (cons nil l) l (append (cdr l) '(( )))
                            )
                        )
                    )
                    ")"
                )
            )
        )
        (vl-string->list (strcase str))
    )
)

(defun LM:getfiles:browseforfolder ( msg dir flg / err fld pth shl slf )
    (setq err
        (vl-catch-all-apply
            (function
                (lambda ( / app hwd )
                    (if (setq app (vlax-get-acad-object)
                              shl (vla-getinterfaceobject app "")
                              hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
                              fld (vlax-invoke-method shl 'browseforfolder (if (vl-catch-all-error-p hwd) 0 hwd) msg flg dir)
                        )
                        (setq slf (vlax-get-property fld 'self)
                              pth (LM:getfiles:fixdir (vlax-get-property slf 'path))
                        )
                    )
                )
            )
        )
    )
    (if slf (vlax-release-object slf))
    (if fld (vlax-release-object fld))
    (if shl (vlax-release-object shl))
    (if (vl-catch-all-error-p err)
        (prompt (vl-catch-all-error-message err))
        pth
    )
)

(defun LM:getfiles:full->relative ( dir path / p q )
    (setq dir (vl-string-right-trim "" dir))
    (cond
        (   (and
                (setq p (vl-string-position 58  dir))
                (setq q (vl-string-position 58 path))
                (/= (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
            )
            path
        )
        (   (and
                (setq p (vl-string-position 92  dir))
                (setq q (vl-string-position 92 path))
                (= (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
            )
            (LM:getfiles:full->relative (substr dir (+ 2 p)) (substr path (+ 2 q)))
        )
        (   (and
                (setq q (vl-string-position 92 path))
                (= (strcase dir) (strcase (substr path 1 q)))
            )
            (strcat "" (substr path (+ 2 q)))
        )
        (   (= "" dir)
            path
        )
        (   (setq p (vl-string-position 92 dir))
            (LM:getfiles:full->relative (substr dir (+ 2 p)) (strcat "..\\" path))
        )
        (   (LM:getfiles:full->relative "" (strcat "..\\" path)))
    )
)

(defun LM:getfiles:str->lst ( str del / pos )
    (if (setq pos (vl-string-search del str))
        (cons (substr str 1 pos) (LM:getfiles:str->lst (substr str (+ pos 1 (strlen del))) del))
        (list str)
    )
)

(defun LM:getfiles:updatefilelist ( dir ext lst )
    (LM:getfiles:listbox "" (LM:getfiles:listfiles dir ext lst))
)

(defun LM:getfiles:updateselected ( dir lst )
    (LM:getfiles:listbox "" (mapcar '(lambda ( x ) (LM:getfiles:full->relative dir x)) lst))
    lst
)

(defun LM:getfiles:updir ( dir )
    (substr dir 1 (vl-string-position 92 dir nil t))
)

(defun LM:getfiles:fixdir ( dir )
    (vl-string-right-trim "" (vl-string-translate "" "" dir))
)

(defun LM:getfiles:removeitems ( itm lst / idx )
    (setq idx -1)
    (vl-remove-if '(lambda ( x ) (member (setq idx (1+ idx)) itm)) lst)
)

Sau đó nó ra 1 list các đường dẫn dạng "...//Myfoder1//Drawing1.dwg" ấy. Dùng open thì không mở được file. Không biết phải xử lý đường dẫn sao để mở được file bạn nhỉ?

Thêm dòng này thì mở được rồi: (strcat "\"" file "\"") là bổ sung dấu " ở đầu và cuối đường dẫn thì phải :D

Tháng 10 15, 2020

@Doan Nguyen Van anh ơi cho em hỏi tí nữa ạ, mấy nay em search khắp rồi không tìm được. em thấy lisp dùng field để link chiều dài vào text của nhiều bác với cả Lee Mac, nhưng tất cả lisp đó đều ko thấy có biểu thức toàn link cả vào trong Field em muốn chèn thêm anh giúp em với.

Kiểu như này [1]12D8a200-L=12345 chỉ có 12345 là Field còn lại thông số kia tự add vào.

Tháng 10 15, 2020

1 phút trước, DungNguyen685 đã nói:

@Doan Nguyen Van anh ơi cho em hỏi tí nữa ạ, mấy nay em search khắp rồi không tìm được. em thấy lisp dùng field để link chiều dài vào text của nhiều bác với cả Lee Mac, nhưng tất cả lisp đó đều ko thấy có biểu thức toàn link cả vào trong Field em muốn chèn thêm anh giúp em với.

Kiểu như này [1]12D8a200-L=12345 chỉ có 12345 là Field còn lại thông số kia tự add vào.

Bạn không gửi file thì mình xem thế nào được

Tháng 10 15, 2020

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

Bạn không gửi file thì mình xem thế nào được

2 cái này a xem cái nào cũng được, em thấy lisp chia sẻ web dùng Field đều giống nhau không chèn thêm được.

QuickFieldV1-3.lsp

LengthAreaFieldV1-3.lsp

Tháng 10 15, 2020

5 phút trước, DungNguyen685 đã nói:

2 cái này a xem cái nào cũng được, em thấy lisp chia sẻ web dùng Field đều giống nhau không chèn thêm được.

QuickFieldV1-3.lsp

LengthAreaFieldV1-3.lsp

Untitled2.png.2c532f9c81ce98ecd1bcab80a0e937eb.png

Xem qua thì cái Length bạn sửa thành thế này là đúng ý rồi

Tháng 10 15, 2020

Vừa xong, Doan Nguyen Van đã nói:

Xem qua thì cái Length bạn sửa thành thế này là đúng ý rồi

Em muốn gán biểu thức vào anh, giờ e nhập lênh chọn đường pline rồi nhaaoj một số thông tin thì lisp tự tính số lượng chiều dài lấy theo pline rồi ghi ra text thì em viết được rồi, giờ em muốn link đuôi ở sau bằng Field mà không được a. chứ ko phải nhập thô vào vậy.

Tháng 10 15, 2020

Như file cad này nè anh, em muốn link vào số 1200 của block hay text á.

Drawing1.dwg

Tháng 10 15, 2020

Lisp rải thép của em đây ạ e muốn link vào chiều dài thanh thép thôi, link vào text được vào block thì quá quá cảm ơn anh luôn.

3. SL12_RAI_THEP_SAN.lsp

Tháng 10 15, 2020

7 phút trước, DungNguyen685 đã nói:

Em muốn gán biểu thức vào anh, giờ e nhập lênh chọn đường pline rồi nhaaoj một số thông tin thì lisp tự tính số lượng chiều dài lấy theo pline rồi ghi ra text thì em viết được rồi, giờ em muốn link đuôi ở sau bằng Field mà không được a. chứ ko phải nhập thô vào vậy.

Nếu chỉ gán đầu và đuôi thì bạn nhập và dùng hàm Strcat nối lại là xong

(defun c:test2 ( )
      (setq tiento (getstring "Nhap tien to:"))
      (setq hauto (getstring "Nhap hau to:"))
      (LM:QuickField "Length" (strcat tiento  "%lu2%pr3%ps[,]%ct8[0.1]"  hauto) 3))

Tháng 10 15, 2020

7 phút trước, Doan Nguyen Van đã nói:
Nếu chỉ gán đầu và đuôi thì bạn nhập và dùng hàm Strcat nối lại là xong
test2.lsp

[✎]
(defun c:test2 ( )
      (setq tiento (getstring "Nhap tien to:"))
      (setq hauto (getstring "Nhap hau to:"))
      (LM:QuickField "Length" (strcat tiento  "%lu2%pr3%ps[,]%ct8[0.1]"  hauto) 3))

Cái này được rồi a, mà đang dùng cho lisp Field a, a chỉ giúp em tách đoạn code đó ra để em tận dụng link vào block với lưu vào thư viện sau này cần dùng gì, chứ làm trên lisp đó em ko hiểu giờ add thêm vào block em chịu chết luôn, em chỉ mới tập tành viết chỉ copy cái này ít cái kia ít à.

Tháng 10 15, 2020

5 phút trước, DungNguyen685 đã nói:

Cái này được rồi a, mà đang dùng cho lisp Field a, a chỉ giúp em tách đoạn code đó ra để em tận dụng link vào block với lưu vào thư viện sau này cần dùng gì, chứ làm trên lisp đó em ko hiểu giờ add thêm vào block em chịu chết luôn, em chỉ mới tập tành viết chỉ copy cái này ít cái kia ít à.

Bạn học 1 chút là sau sẽ tự áp dụng được, cái này ở mức rất đơn giản thôi, mình chỉ bạn đc nhưng k thể cái nào cũng chỉ hết được

Tháng 10 15, 2020

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

Bạn học 1 chút là sau sẽ tự áp dụng được, cái này ở mức rất đơn giản thôi, mình chỉ bạn đc nhưng k thể cái nào cũng chỉ hết được

Cảm ơn anh! em cũng đang học từng chút. giờ cứ mò gặp đến đâu học đến đó thôi chứ không biết bắt đầu từ đầu như thế nào.

Tháng 10 15, 2020

4 giờ trước, Doan Nguyen Van đã nói:

Bạn học 1 chút là sau sẽ tự áp dụng được, cái này ở mức rất đơn giản thôi, mình chỉ bạn đc nhưng k thể cái nào cũng chỉ hết được

Anh giúp em với thật sự em không biết cách nào Link được chiều dài vào anh ơi, anh giúp em với!

TT.dwg

TT.lsp

Tháng 10 16, 2020

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

Anh giúp em với thật sự em không biết cách nào Link được chiều dài vào anh ơi, anh giúp em với!

TT.dwg

TT.lsp

Nói thật là mình vẫn không rõ ý tưởng của bạn thế nào mà hướng dẫn, inbox chi tiết mình xem cho nhé

Tháng 10 24, 2020

Mọi người cho hỏi tí: tôi muốn lấy góc của đường kích thước nhưng dùng hàm dưới đây để lấy điểm thứ nhất thì có Dim ok nhưng có Dim bị err là vì sao vậy?

(setq p (vlax-get (vlax-ename->vla-object (car (entsel "\nChon Dim: "))) 'ExtLine1Point))

Err_Dim.dwg

Tháng 10 24, 2020

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

Mọi người cho hỏi tí: tôi muốn lấy góc của đường kích thước nhưng dùng hàm dưới đây để lấy điểm thứ nhất thì có Dim ok nhưng có Dim bị err là vì sao vậy?

(setq p (vlax-get (vlax-ename->vla-object (car (entsel "\nChon Dim: "))) 'ExtLine1Point))

Err_Dim.dwg

Rotate Dimension ( Không áp dụng ) >< Aligned Dimension . ( Áp dụng được )

:)))) Cháu có ý kiến thế thôi ạ. ^^

Tháng 10 24, 2020

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

Mọi người cho hỏi tí: tôi muốn lấy góc của đường kích thước nhưng dùng hàm dưới đây để lấy điểm thứ nhất thì có Dim ok nhưng có Dim bị err là vì sao vậy?

(setq p (vlax-get (vlax-ename->vla-object (car (entsel "\nChon Dim: "))) 'ExtLine1Point))

Err_Dim.dwg

Bác có thể lấy Mã DXF 13 của dim, là point của extline1, nhưng đối với dim Rotated thì như thế vẫn chưa đủ để xác định góc, vì chân dim dài ngắn bất đồng, cần 1 vài thủ thuật khác để lấy góc, hoặc bác có thể đi đường tắt bằng cách lấy góc của text dim cho nhanh

Tháng 10 24, 2020

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

Bác có thể lấy Mã DXF 13 của dim, là point của extline1, nhưng đối với dim Rotated thì như thế vẫn chưa đủ để xác định góc, vì chân dim dài ngắn bất đồng, cần 1 vài thủ thuật khác để lấy góc, hoặc bác có thể đi đường tắt bằng cách lấy góc của text dim cho nhanh

Nhìn hình ví dụ thì góc text không đúng theo góc của 2 điểm extline của dim mà bác.

Đăng nhập

Hỏi về Lisp (thuật toán, ý tưởng, coding,...)

Các bài được khuyến nghị

naturooo 36

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

naturooo 36

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Nguyen Van 489

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Nguyen Van 489

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

naturooo 36

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

naturooo 36

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Nguyen Van 489

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Nguyen Van 489

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Nguyen Van 489

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

Doan Nguyen Van 489

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40

Chia sẻ bài đăng này

Liên kết tới bài đăng

Chia sẻ trên các trang web khác

DungNguyen685 40