找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1389|回复: 18

[每日一码] 看看我修改的批量或单张插入影像到CAD中

[复制链接]

已领礼包: 1个

财富等级: 恭喜发财

发表于 2018-5-11 09:12:17 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

您需要 登录 才可以下载或查看,没有账号?立即注册

×
本帖最后由 newer 于 2018-5-11 09:47 编辑

在网上看了好多插入影像的程序,总感觉到不太适合我的需要,于是根据网上的代码,自己整合了一个,发出来给大家看看,希望能对大家有用。
本想发代码的,结果提交不了,提示补拦截,只能发附件了!
  1. ---------------------------------| ;
  2. (vl-load-com)

  3. (if (null degrad)
  4.   (defun degrad (ang) (* pi (/ ang 180.0)))
  5. )

  6. (if (null raddeg)
  7.   (defun raddeg (ang) (* 180.0 (/ ang pi)))
  8. )
  9. (defun c:inimg ()
  10.   (initget "1 2")
  11.   (princ "\n选择插入影像方式:")
  12.   (setq key (getkword "\n1单张\\2批量\\<1>:"))
  13.   (cond ((not key) (dz))                ;
  14.         ((= key "1") (dz))              ;
  15.         ((= key "2") (pl))              ;
  16.   )                                     ;cond
  17. )
  18. (defun dz ()
  19.   (findfile (setq im (getfiled "选择影像文件"
  20.                                (getvar "dwgprefix")
  21.                                "tif;jpg;png;ecw"
  22.                                16
  23.                      )
  24.             )
  25.   )
  26.   (tfw im)
  27. )
  28. (defun pl ()
  29.   (setq dir (LM:getfiles "选择文件" "" "tif;jpg;png;ecw"))
  30.   (repeat (setq n (length dir))
  31.     (setq kk (length dir))
  32.     (setq n (1- n))
  33.     (setq e (nth n dir))
  34.     (setq k (- kk n))
  35.     (princ (strcat "\n正在插入 " (itoa k) "张影像......"))
  36.     (tfw e)
  37.   )
  38.   (princ
  39.     (strcat "\n完成!成功插入 " (itoa (length dir)) "张影像!")
  40.   )
  41.   (princ)
  42. )
  43. (defun tfw (im / img file res pt xres yres xrot yrot left top minpt maxpt
  44.            )                            ;define the function name and variables
  45.   (if (= (type im) 'str)
  46.     (progn (setq img (vla-addraster
  47.                        (vla-get-block
  48.                          (vla-get-activelayout
  49.                            (vla-get-activedocument (vlax-get-acad-object))
  50.                          )
  51.                        )
  52.                        im
  53.                        (vlax-make-variant
  54.                          (vlax-safearray-fill
  55.                            (vlax-make-safearray vlax-vbdouble (cons 0 2))
  56.                            '(0.0 0.0 0.0)
  57.                          )
  58.                        )
  59.                        1.0
  60.                        0.0
  61.                      )
  62.            )
  63.            (if (snvalid (vl-filename-base im))
  64.              (vla-put-name img (vl-filename-base im))
  65.            )
  66.            (setq im (vlax-vla-object->ename img))
  67.     )
  68.     (setq imG (vlax-ename->vla-object (ssname im 0)))
  69.   )
  70.   (if (findfile (vl-string-subst
  71.                   ".ers"
  72.                   (vl-filename-extension (vla-get-imagefile img))
  73.                   (vla-get-imagefile img)
  74.                 )
  75.       )
  76.     (setq file (vl-string-subst
  77.                  ".ers"
  78.                  (vl-filename-extension (vla-get-imagefile img))
  79.                  (vla-get-imagefile img)
  80.                )
  81.     )
  82.     (if (findfile (vl-string-subst
  83.                     ".tfw"
  84.                     (vl-filename-extension (vla-get-imagefile img))
  85.                     (vla-get-imagefile img)
  86.                   )
  87.         )
  88.       (setq file (vl-string-subst
  89.                    ".tfw"
  90.                    (vl-filename-extension (vla-get-imagefile img))
  91.                    (vla-get-imagefile img)
  92.                  )
  93.       )
  94.       (if (findfile (vl-string-subst
  95.                       ".jgw"
  96.                       (vl-filename-extension (vla-get-imagefile img))
  97.                       (vla-get-imagefile img)
  98.                     )
  99.           )
  100.         (setq file (vl-string-subst
  101.                      ".jgw"
  102.                      (vl-filename-extension (vla-get-imagefile img))
  103.                      (vla-get-imagefile img)
  104.                    )
  105.         )
  106.         (if (findfile (vl-string-subst
  107.                         ".pgw"
  108.                         (vl-filename-extension (vla-get-imagefile img))
  109.                         (vla-get-imagefile img)
  110.                       )
  111.             )
  112.           (setq file (vl-string-subst
  113.                        ".pgw"
  114.                        (vl-filename-extension (vla-get-imagefile img))
  115.                        (vla-get-imagefile img)
  116.                      )
  117.           )
  118.         )
  119.       )
  120.     )
  121.   )
  122.   (if (or file
  123.           (setq file (getfiled "选择坐标文件"
  124.                                (vl-string-subst
  125.                                  ""
  126.                                  (vl-filename-extension (vla-get-imagefile img))
  127.                                  (vla-get-imagefile img)
  128.                                )
  129.                                "tfw;jgw;pgw;ers"
  130.                                0
  131.                      )
  132.           )
  133.       )
  134.     (if (= (vl-filename-extension file) ".ers")
  135.       (progn (setq file (open file "r"))
  136.              (repeat 19 (read-line file))
  137.              (setq left (atof (last (split (read-line file) " ")))
  138.                    top  (atof (last (split (read-line file) " ")))
  139.              )
  140.              (close file)
  141.              (vla-put-origin
  142.                img
  143.                (vlax-make-variant
  144.                  (vlax-safearray-fill
  145.                    (vlax-make-safearray 5 (cons 0 2))
  146.                    (list left (- top (vla-get-height img)) 0.0)
  147.                  )
  148.                )
  149.              )
  150.              (vla-put-imagewidth img (vla-get-width img))
  151.              (vla-put-imageheight img (vla-get-height img))
  152.              (vla-getboundingbox img 'minpt 'maxpt)
  153.              (vla-zoomwindow (vlax-get-acad-object) minpt maxpt)
  154.       )
  155.       (progn (setq file (open file "r")
  156.                    xres (atof (read-line file))
  157.                    xrot (atof (read-line file))
  158.                    yrot (atof (read-line file))
  159.                    yres (atof (read-line file))
  160.                    ins  (list (atof (read-line file)) (atof (read-line file)) 0.0)
  161.                    ins  (polar ins
  162.                                (* (/ (+ xrot 90.0) 180.0) pi)
  163.                                (* (vla-get-height img) yres)
  164.                         )
  165.              )
  166.              (close file)
  167.              (vla-put-rotation img (degrad xrot))
  168.              (vla-put-origin
  169.                img
  170.                (vlax-make-variant
  171.                  (vlax-safearray-fill (vlax-make-safearray 5 (cons 0 2)) ins)
  172.                )
  173.              )
  174.              (vla-put-imageheight
  175.                img
  176.                (* (vla-get-height img) (abs yres))
  177.              )
  178.              (vla-put-imagewidth img (* (vla-get-width img) (abs xres)))
  179.              (vla-getboundingbox img 'minpt 'maxpt)
  180.              (vla-zoomwindow (vlax-get-acad-object) minpt maxpt)
  181.       )
  182.     )
  183.   )                                     ;)
  184.                                         ;  )
  185.   (princ)                               ;exit quietly
  186. )

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

  202. (defun LM:getfiles (msg def ext / *error* dch dcl des dir dirdata lst rtn)
  203.   (defun *error* (msg)
  204.     (if (= 'file (type des))
  205.       (close des)
  206.     )
  207.     (if (and (= 'int (type dch)) (< 0 dch))
  208.       (unload_dialog dch)
  209.     )
  210.     (if (and (= 'str (type dcl)) (findfile dcl))
  211.       (vl-file-delete dcl)
  212.     )
  213.     (if (and msg
  214.              (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  215.         )
  216.       (princ (strcat "\nError: " msg))
  217.     )
  218.     (princ)
  219.   )
  220.   (if (and (setq dcl (vl-filename-mktemp nil nil ".dcl"))
  221.            (setq des (open dcl "w"))
  222.            (progn (foreach x '("lst : list_box" "{" "    width = 40.0;" "    height = 20.0;"
  223.                                "    fixed_width = true;" "    fixed_height = true;"
  224.                                "    alignment = centered;" "    multiple_select = true;" "}"
  225.                                "but : button" "{" "    width = 20.0;" "    height = 1.8;"
  226.                                "    fixed_width = true;" "    fixed_height = true;"
  227.                                "    alignment = centered;" "}" "getfiles : dialog" "{"
  228.                                "    key = \"title\"; spacer;" "    : row" "    {"
  229.                                "        alignment = centered;"
  230.                                "        : edit_box { key = \"dir\"; label = \"目录:\"; }"
  231.                                "        : button" "        {" "            key = \"brw\";"
  232.                                "            label = \"浏览\";" "            fixed_width = true;"
  233.                                "        }" "    }" "    spacer;" "    : row" "    {"
  234.                                "        : column" "        {"
  235.                                "            : lst { key = \"box1\"; }"
  236.                                "            : but { key = \"add\" ; label = \"添加文件\"; }"
  237.                                "        }" "        : column {"
  238.                                "            : lst { key = \"box2\"; }"
  239.                                "            : but { key = \"del\" ; label = \"移除文件\"; }"
  240.                                "        }" "    }" "    spacer; ok_cancel;" "}"
  241.                               )
  242.                     (write-line x des)
  243.                   )
  244.                   (setq des (close des))
  245.                   (< 0 (setq dch (load_dialog dcl)))
  246.            )
  247.            (new_dialog "getfiles" dch)
  248.       )
  249.     (progn (setq ext (if (= 'str (type ext))
  250.                        (LM:getfiles:str->lst (strcase ext) ";")
  251.                        '("*")
  252.                      )
  253.            )
  254.            (set_tile "title"
  255.                      (if (member msg '(nil ""))
  256.                        "选择文件"
  257.                        msg
  258.                      )
  259.            )
  260.            (set_tile "dir"
  261.                      (setq dir (LM:getfiles:fixdir
  262.                                  (if (or (member def '(nil ""))
  263.                                          (not (vl-file-directory-p (LM:getfiles:fixdir def)))
  264.                                      )
  265.                                    (getvar 'dwgprefix)
  266.                                    def
  267.                                  )
  268.                                )
  269.                      )
  270.            )
  271.            (setq lst (LM:getfiles:updatefilelist dir ext nil))
  272.            (mode_tile "add" 1)
  273.            (mode_tile "del" 1)
  274.            (action_tile
  275.              "brw"
  276.              (vl-prin1-to-string
  277.                '(if
  278.                  (setq tmp (LM:getfiles:browseforfolder "" nil 512))
  279.                  (setq
  280.                   lst
  281.                   (LM:getfiles:updatefilelist
  282.                    (set_tile "dir" (setq dir tmp))
  283.                    ext
  284.                    rtn
  285.                   )
  286.                   rtn
  287.                   (LM:getfiles:updateselected dir rtn)
  288.                  )
  289.                 )
  290.              )
  291.            )
  292.            (action_tile
  293.              "dir"
  294.              (vl-prin1-to-string
  295.                '(if
  296.                  (= 1 $reason)
  297.                  (setq
  298.                   lst
  299.                   (LM:getfiles:updatefilelist
  300.                    (set_tile "dir" (setq dir (LM:getfiles:fixdir $value)))
  301.                    ext
  302.                    rtn
  303.                   )
  304.                   rtn
  305.                   (LM:getfiles:updateselected dir rtn)
  306.                  )
  307.                 )
  308.              )
  309.            )
  310.            (action_tile
  311.              "box1"
  312.              (vl-prin1-to-string
  313.                '((lambda (/ itm tmp)
  314.                    (if
  315.                     (setq
  316.                      itm
  317.                      (mapcar
  318.                       '(lambda (n) (nth n lst))
  319.                       (read (strcat "(" $value ")"))
  320.                      )
  321.                     )
  322.                     (if
  323.                      (= 4 $reason)
  324.                      (cond
  325.                       ((equal '("..") itm)
  326.                        (setq
  327.                         lst
  328.                         (LM:getfiles:updatefilelist
  329.                          (set_tile "dir" (setq dir (LM:getfiles:updir dir)))
  330.                          ext
  331.                          rtn
  332.                         )
  333.                         rtn
  334.                         (LM:getfiles:updateselected dir rtn)
  335.                        )
  336.                       )
  337.                       ((vl-file-directory-p
  338.                         (setq
  339.                          tmp
  340.                          (LM:getfiles:checkredirect (strcat dir "\\" (car itm)))
  341.                         )
  342.                        )
  343.                        (setq
  344.                         lst
  345.                         (LM:getfiles:updatefilelist
  346.                          (set_tile "dir" (setq dir tmp))
  347.                          ext
  348.                          rtn
  349.                         )
  350.                         rtn
  351.                         (LM:getfiles:updateselected dir rtn)
  352.                        )
  353.                       )
  354.                       ((setq
  355.                         rtn
  356.                         (LM:getfiles:sort
  357.                          (append rtn (mapcar '(lambda (x) (strcat dir "\\" x)) itm))
  358.                         )
  359.                         rtn
  360.                         (LM:getfiles:updateselected dir rtn)
  361.                         lst
  362.                         (LM:getfiles:updatefilelist dir ext rtn)
  363.                        )
  364.                       )
  365.                      )
  366.                      (if
  367.                       (vl-every
  368.                        '(lambda (x) (vl-file-directory-p (strcat dir "\\" x)))
  369.                        itm
  370.                       )
  371.                       (mode_tile "add" 1)
  372.                       (mode_tile "add" 0)
  373.                      )
  374.                     )
  375.                    )
  376.                  )
  377.                 )
  378.              )
  379.            )
  380.            (action_tile
  381.              "box2"
  382.              (vl-prin1-to-string
  383.                '((lambda (/ itm)
  384.                    (if
  385.                     (setq
  386.                      itm
  387.                      (mapcar
  388.                       '(lambda (n) (nth n rtn))
  389.                       (read (strcat "(" $value ")"))
  390.                      )
  391.                     )
  392.                     (if
  393.                      (= 4 $reason)
  394.                      (setq
  395.                       rtn
  396.                       (LM:getfiles:updateselected dir (vl-remove (car itm) rtn))
  397.                       lst
  398.                       (LM:getfiles:updatefilelist dir ext rtn)
  399.                      )
  400.                      (mode_tile "del" 0)
  401.                     )
  402.                    )
  403.                  )
  404.                 )
  405.              )
  406.            )
  407.            (action_tile
  408.              "add"
  409.              (vl-prin1-to-string
  410.                '((lambda (/ itm)
  411.                    (if
  412.                     (setq
  413.                      itm
  414.                      (vl-remove-if
  415.                       'vl-file-directory-p
  416.                       (mapcar
  417.                        '(lambda (n) (nth n lst))
  418.                        (read (strcat "(" (get_tile "box1") ")"))
  419.                       )
  420.                      )
  421.                     )
  422.                     (setq
  423.                      rtn
  424.                      (LM:getfiles:sort
  425.                       (append rtn (mapcar '(lambda (x) (strcat dir "\\" x)) itm))
  426.                      )
  427.                      rtn
  428.                      (LM:getfiles:updateselected dir rtn)
  429.                      lst
  430.                      (LM:getfiles:updatefilelist dir ext rtn)
  431.                     )
  432.                    )
  433.                    (mode_tile "add" 1)
  434.                    (mode_tile "del" 1)
  435.                  )
  436.                 )
  437.              )
  438.            )
  439.            (action_tile
  440.              "del"
  441.              (vl-prin1-to-string
  442.                '((lambda (/ itm)
  443.                    (if
  444.                     (setq itm (read (strcat "(" (get_tile "box2") ")")))
  445.                     (setq
  446.                      rtn
  447.                      (LM:getfiles:updateselected
  448.                       dir
  449.                       (LM:getfiles:removeitems itm rtn)
  450.                      )
  451.                      lst
  452.                      (LM:getfiles:updatefilelist dir ext rtn)
  453.                     )
  454.                    )
  455.                    (mode_tile "add" 1)
  456.                    (mode_tile "del" 1)
  457.                  )
  458.                 )
  459.              )
  460.            )
  461.            (if (zerop (start_dialog))
  462.              (setq rtn nil)
  463.            )
  464.     )
  465.   )
  466.   (*error* nil)
  467.   rtn
  468. )
  469. (defun LM:getfiles:listbox (key lst)
  470.   (start_list key)
  471.   (foreach x lst (add_list x))
  472.   (end_list)
  473.   lst
  474. )
  475. (defun LM:getfiles:listfiles (dir ext lst)
  476.   (vl-remove-if
  477.     '(lambda (x) (member (strcat dir "\\" x) lst))
  478.     (cond ((cdr (assoc dir dirdata)))
  479.           ((cdar (setq dirdata
  480.                         (cons
  481.                           (cons dir
  482.                                 (append (LM:getfiles:sortlist
  483.                                           (vl-remove "." (vl-directory-files dir nil -1))
  484.                                         )
  485.                                         (LM:getfiles:sort
  486.                                           (if (member ext '(("") ("*")))
  487.                                             (vl-directory-files dir nil 1)
  488.                                             (vl-remove-if-not
  489.                                               (function (lambda (x / e)
  490.                                                           (and (setq e (vl-filename-extension x))
  491.                                                                (setq e (strcase (substr e 2)))
  492.                                                                (vl-some '(lambda (w) (wcmatch e w)) ext)
  493.                                                           )
  494.                                                         )
  495.                                               )
  496.                                               (vl-directory-files dir nil 1)
  497.                                             )
  498.                                           )
  499.                                         )
  500.                                 )
  501.                           )
  502.                           dirdata
  503.                         )
  504.                  )
  505.            )
  506.           )
  507.     )
  508.   )
  509. )
  510. (defun LM:getfiles:checkredirect (dir / itm pos)
  511.   (cond ((vl-directory-files dir) dir)
  512.         ((and (= (strcase (getenv "UserProfile"))
  513.                  (strcase
  514.                    (substr dir 1 (setq pos (vl-string-position 92 dir nil t)))
  515.                  )
  516.               )
  517.               (setq itm (cdr (assoc (substr (strcase dir t) (+ pos 2))
  518.                                     '(("my documents" . "Documents")
  519.                                       ("my pictures" . "Pictures")
  520.                                       ("my videos" . "Videos")
  521.                                       ("my music" . "Music")
  522.                                      )
  523.                              )
  524.                         )
  525.               )
  526.               (vl-file-directory-p
  527.                 (setq itm (strcat (substr dir 1 pos) "\\" itm))
  528.               )
  529.          )
  530.          itm
  531.         )
  532.         (dir)
  533.   )
  534. )
  535. (defun LM:getfiles:sort (lst)
  536.   (apply 'append
  537.          (mapcar 'LM:getfiles:sortlist
  538.                  (vl-sort (LM:getfiles:groupbyfunction
  539.                             lst
  540.                             (lambda (a b / x y)
  541.                               (and (setq x (vl-filename-extension a))
  542.                                    (setq y (vl-filename-extension b))
  543.                                    (= (strcase x) (strcase y))
  544.                               )
  545.                             )
  546.                           )
  547.                           (function (lambda (a b / x y)
  548.                                       (and (setq x (vl-filename-extension (car a)))
  549.                                            (setq y (vl-filename-extension (car b)))
  550.                                            (< (strcase x) (strcase y))
  551.                                       )
  552.                                     )
  553.                           )
  554.                  )
  555.          )
  556.   )
  557. )
  558. (defun LM:getfiles:sortlist (lst)
  559.   (mapcar (function (lambda (n) (nth n lst)))
  560.           (vl-sort-i (mapcar 'LM:getfiles:splitstring lst)
  561.                      (function
  562.                        (lambda (a b / x y)
  563.                          (while (and (setq x (car a)) (setq y (car b)) (= x y))
  564.                            (setq a (cdr a)
  565.                                  b (cdr b)
  566.                            )
  567.                          )
  568.                          (cond ((null x) b)
  569.                                ((null y) nil)
  570.                                ((and (numberp x) (numberp y)) (< x y))
  571.                                ((numberp x))
  572.                                ((numberp y) nil)
  573.                                ((< x y))
  574.                          )
  575.                        )
  576.                      )
  577.           )
  578.   )
  579. )
  580. (defun LM:getfiles:groupbyfunction (lst fun / tmp1 tmp2 x1)
  581.   (if (setq x1 (car lst))
  582.     (progn (foreach x2 (cdr lst)
  583.              (if (fun x1 x2)
  584.                (setq tmp1 (cons x2 tmp1))
  585.                (setq tmp2 (cons x2 tmp2))
  586.              )
  587.            )
  588.            (cons (cons x1 (reverse tmp1))
  589.                  (LM:getfiles:groupbyfunction (reverse tmp2) fun)
  590.            )
  591.     )
  592.   )
  593. )
  594. (defun LM:getfiles:splitstring (str)
  595.   ((lambda (l)
  596.      (read
  597.        (strcat "("
  598.                (vl-list->string
  599.                  (apply 'append
  600.                         (mapcar (function (lambda (a b c)
  601.                                             (cond ((member b '(45 46 92)) (list 32))
  602.                                                   ((< 47 b 58) (list b))
  603.                                                   ((list 32 34 b 34 32))
  604.                                             )
  605.                                           )
  606.                                 )
  607.                                 (cons nil l)
  608.                                 l
  609.                                 (append (cdr l) '(()))
  610.                         )
  611.                  )
  612.                )
  613.                ")"
  614.        )
  615.      )
  616.    )
  617.     (vl-string->list (strcase str))
  618.   )
  619. )
  620. (defun LM:getfiles:browseforfolder (msg dir flg / err fld pth shl slf)
  621.   (setq err (vl-catch-all-apply
  622.               (function (lambda (/ app hwd)
  623.                           (if (setq app (vlax-get-acad-object)
  624.                                     shl (vla-getinterfaceobject app "shell.application")
  625.                                     hwd (vl-catch-all-apply 'vla-get-hwnd (list app))
  626.                                     fld (vlax-invoke-method
  627.                                           shl
  628.                                           'browseforfolder
  629.                                           (if (vl-catch-all-error-p hwd)
  630.                                             0
  631.                                             hwd
  632.                                           )
  633.                                           msg
  634.                                           flg
  635.                                           dir
  636.                                         )
  637.                               )
  638.                             (setq slf (vlax-get-property fld 'self)
  639.                                   pth (LM:getfiles:fixdir (vlax-get-property slf 'path))
  640.                             )
  641.                           )
  642.                         )
  643.               )
  644.             )
  645.   )
  646.   (if slf
  647.     (vlax-release-object slf)
  648.   )
  649.   (if fld
  650.     (vlax-release-object fld)
  651.   )
  652.   (if shl
  653.     (vlax-release-object shl)
  654.   )
  655.   (if (vl-catch-all-error-p err)
  656.     (prompt (vl-catch-all-error-message err))
  657.     pth
  658.   )
  659. )
  660. (defun LM:getfiles:full->relative (dir path / p q)
  661.   (setq dir (vl-string-right-trim "\\" dir))
  662.   (cond ((and (setq p (vl-string-position 58 dir))
  663.               (setq q (vl-string-position 58 path))
  664.               (/= (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
  665.          )
  666.          path
  667.         )
  668.         ((and (setq p (vl-string-position 92 dir))
  669.               (setq q (vl-string-position 92 path))
  670.               (= (strcase (substr dir 1 p)) (strcase (substr path 1 q)))
  671.          )
  672.          (LM:getfiles:full->relative
  673.            (substr dir (+ 2 p))
  674.            (substr path (+ 2 q))
  675.          )
  676.         )
  677.         ((and (setq q (vl-string-position 92 path))
  678.               (= (strcase dir) (strcase (substr path 1 q)))
  679.          )
  680.          (strcat ".\\" (substr path (+ 2 q)))
  681.         )
  682.         ((= "" dir) path)
  683.         ((setq p (vl-string-position 92 dir))
  684.          (LM:getfiles:full->relative
  685.            (substr dir (+ 2 p))
  686.            (strcat "..\\" path)
  687.          )
  688.         )
  689.         ((LM:getfiles:full->relative "" (strcat "..\\" path)))
  690.   )
  691. )
  692. (defun LM:getfiles:str->lst (str del / pos)
  693.   (if (setq pos (vl-string-search del str))
  694.     (cons (substr str 1 pos)
  695.           (LM:getfiles:str->lst
  696.             (substr str (+ pos 1 (strlen del)))
  697.             del
  698.           )
  699.     )
  700.     (list str)
  701.   )
  702. )
  703. (defun LM:getfiles:updatefilelist (dir ext lst)
  704.   (LM:getfiles:listbox
  705.     "box1"
  706.     (LM:getfiles:listfiles dir ext lst)
  707.   )
  708. )
  709. (defun LM:getfiles:updateselected (dir lst)
  710.   (LM:getfiles:listbox
  711.     "box2"
  712.     (mapcar '(lambda (x) (LM:getfiles:full->relative dir x))
  713.             lst
  714.     )
  715.   )
  716.   lst
  717. )
  718. (defun LM:getfiles:updir (dir)
  719.   (substr dir 1 (vl-string-position 92 dir nil t))
  720. )
  721. (defun LM:getfiles:fixdir (dir)
  722.   (vl-string-right-trim
  723.     "\\"
  724.     (vl-string-translate "/" "\\" dir)
  725.   )
  726. )
  727. (defun LM:getfiles:removeitems (itm lst / idx)
  728.   (setq idx -1)
  729.   (vl-remove-if
  730.     '(lambda (x) (member (setq idx (1+ idx)) itm))
  731.     lst
  732.   )
  733. )
  734. (vl-load-com)
  735. (princ)




请点击此处下载

查看状态:需购买或无权限

您的用户组是:游客

文件名称:inimg.rar 
下载次数:59  文件大小:4.52 KB 
下载权限: 不限 以上  [免费赚D豆]



评分

参与人数 1D豆 +5 收起 理由
/db_自贡黄明儒_ + 5 很给力!经验;技术要点;资料分享奖!

查看全部评分

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!

已领礼包: 1个

财富等级: 恭喜发财

 楼主| 发表于 2018-5-11 09:18:49 | 显示全部楼层
本帖最后由 qingchao 于 2018-5-11 10:05 编辑

对不起大家了,第一次发贴,不太会,现在给大家上张图片
GIF.gif

点评

别人都能发,你发不了,应该找自己原因------------  详情 回复 发表于 2018-5-11 09:39
附件压缩成RAR  详情 回复 发表于 2018-5-11 09:20
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2018-5-11 09:20:16 | 显示全部楼层
qingchao 发表于 2018-5-11 09:18
对不起大家了,附件也发不上来,晕,什么网站啊

附件压缩成RAR
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1个

财富等级: 恭喜发财

 楼主| 发表于 2018-5-11 09:25:33 | 显示全部楼层

谢谢了,我看附件上传的时候有lsp,我以为可以直接发!不能发代码是权限的问题

点评

你这个和网上其他的,有什么不同呢,你加入了哪些你需要的,介绍下啊。  详情 回复 发表于 2018-5-11 09:42
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1336个

财富等级: 财源广进

发表于 2018-5-11 09:39:07 | 显示全部楼层
qingchao 发表于 2018-5-11 09:18
对不起大家了,附件也发不上来,晕,什么网站啊

别人都能发,你发不了,应该找自己原因------------
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 40个

财富等级: 招财进宝

发表于 2018-5-11 09:42:37 | 显示全部楼层
qingchao 发表于 2018-5-11 09:25
谢谢了,我看附件上传的时候有lsp,我以为可以直接发!不能发代码是权限的问题

你这个和网上其他的,有什么不同呢,你加入了哪些你需要的,介绍下啊。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 20个

财富等级: 恭喜发财

发表于 2018-5-11 09:53:06 | 显示全部楼层
楼主看看这个
http://bbs.xdcad.net/thread-711226-1-1.html


                               
登录/注册后可看大图


有朋友申请这个:http://bbs.xdcad.net/thread-711216-1-1.html就写了个。


批量行列表格式插入图像,可设置长,宽,间距。

选择多个图片后,在当前图形目录下,建立个images目录,把所有图片拷贝到images下。
插入图片用相对路径。确保以后存档不丢失图片。以后把DWG和IMAGES目录一起打包拷贝到其他机器可以正常显示图像。

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1个

财富等级: 恭喜发财

 楼主| 发表于 2018-5-11 09:53:38 | 显示全部楼层
本帖最后由 qingchao 于 2018-5-11 09:56 编辑
newer 发表于 2018-5-11 09:42
你这个和网上其他的,有什么不同呢,你加入了哪些你需要的,介绍下啊。

我是看了本版发出来的一个帖子才想到发的,他的帖子中需要在命令行执行函数+参数的形式,而我这个只用执行命令,选择文件就可以插入了,可以单张,也可以批量,相对我们这种小白来说,操作更方便一些!另外,没有定位文件的,也可以选择定位文件!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 6468个

财富等级: 富甲天下

发表于 2018-5-11 09:55:28 | 显示全部楼层
上传些图片上来能更方便介绍,我都没看懂!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 812个

财富等级: 财运亨通

发表于 2018-5-11 10:46:33 | 显示全部楼层
本帖最后由 liunian0524 于 2018-5-11 11:07 编辑

感谢楼主分享,坐标文件?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 3701个

财富等级: 富可敌国

发表于 2018-5-11 13:56:38 | 显示全部楼层
谢谢分享,学习学习!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 675个

财富等级: 财运亨通

发表于 2018-5-11 14:56:34 | 显示全部楼层
功能不错,谢谢了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2018-6-12 11:58:49 | 显示全部楼层
学习学习
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

发表于 2018-6-14 13:10:59 | 显示全部楼层
不需要定位 单纯的批量插入tif图片 怎么操作呢 我加载后一直提示 定位
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1个

财富等级: 恭喜发财

 楼主| 发表于 2018-6-14 14:59:03 | 显示全部楼层
依然小小鸟 发表于 2018-6-14 13:10
不需要定位 单纯的批量插入tif图片 怎么操作呢 我加载后一直提示 定位

请看7楼,可以指定位置,我这个是带坐标文件的
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-3-29 18:42 , Processed in 0.498550 second(s), 65 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

快速回复 返回顶部 返回列表