批量插入光栅图

434939575

2. (defun c:tt(/ )
   
3.   (setq i 1)
   
4.   (setq ang 0)
   
5.   (setq n 0)
   
6.   (main)
   
7.   (prin1)
   
8. )
   
9. (defun main( / pt)
   
10.   (setq dcl_id (load_dialog (make-dcl)))
    
11.   (new_dialog "gst" dcl_id)
    
12.   (set_tile "kzkd" "100")
    
13.   (setq kd(atof(get_tile"kzkd" )))
    
14.   (set_tile "zjjl" "20")
    
15.   (set_tile "mxgs" "10")
    
16.   (setq jl(atof(get_tile"zjjl" )))
    
17.   (action_tile "dkwj" "(done_dialog 1)")
    
18.   (setq dd(start_dialog))
    
19.   (if (= dd 1)
    
20.     (progn
    
21.       (find_file)
    
22.       (if(not pt) (setq pt(getpoint"\n插入点")))
    
23.       (setq pt: pt)
    
24.       (foreach   f filelist
    
25.         (inpic (strcat path"\" f  )pt  )
    
26.         (setq las(entlast))
    
27.         (setq bx(box las))
    
28.         (setq wh(mapcar 'abs (mapcar '- (car bx)(cadr bx))))
    
29.         (command "SCALE" las"" "non" pt (/ kd (car wh)) )
    
30.         (setq i(1+ i))
    
31.         (if (/= (rem  i 11 )1  )
    
32.           (setq ang 0)
    
33.           (progn(setq ang (* 0.5 pi))
    
34.             (setq i 1)
    
35.             (setq n(1+ n))
    
36.             (setq pt  (polar pt: ang (* n(* 2 kd))))
    
37.           )
    
38.         )
    
39.         (setq pt  (polar pt ang (+ jl kd)))
    
40.       )
    
41.     )
    
42.   )
    
43. )
    
44. (defun inpic (path::  pta /)
    
45.   (vla-AddRaster
    
46.     (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object)))
    
47.     path::
    
48.     (vlax-3d-point   pta
    
49.     )
    
50.     1
    
51.     0
    
52.   )
    
53. )
    
54. (defun box (ss0 / ptmi ptma)
    
55.   (vla-getboundingbox
    
56.     (vlax-ename->vla-object ss0)
    
57.     'ptmi
    
58.     'ptma
    
59.   )
    
60.   (mapcar 'vlax-safearray->list (list ptmi ptma))
    
61. )
    
62. (defun find_file ()
    
63.   (setq FILE: (getfiled "选择文件夹内一个文件"
    
64.                 ""
    
65.                 ""
    
66.                 4
    
67.               )
    
68.   )
    
69.   (setq path     (vl-filename-directory FILE:)
    
70.     filelist (vl-directory-files path "*.jpg")
    
71.   ))
    
72. (defun make-dcl  (/ lst_str str file f)
    
73.   (setq lst_str '(
    
74.                    "gst:dialog"
    
75.                    "{ "
    
76.                    "     label = "批量插入光栅图";"
    
77.                    "         :row"
    
78.                    "     { "
    
79.                    "          :button"
    
80.                    "          { "
    
81.                    "               key = "dkwj";"
    
82.                    "               label = "打开文件夹";"
    
83.                    "               width = 12.15;"
    
84.                    "               height = 1.875;"
    
85.                    "               fixed_height = true;"
    
86.                    "               fixed_width = true;"
    
87.                    "          } "
    
88.                    "     } "
    
89.                    "     :row"
    
90.                    "     {"
    
91.                    "          :text"
    
92.                    "          {"
    
93.                    "              "
    
94.                    "               label = "图片宽度";"
    
95.                    "               fixed_height = true;"
    
96.                    "               fixed_width = true;"
    
97.                    "          } "
    
98.                    "          :edit_box"
    
99.                    "          { "
    
100.                    "               key = "kzkd";"
     
101.                    "               width = 12.15;"
     
102.                    "               height = 0.938;"
     
103.                    "               fixed_height = true;"
     
104.                    "               fixed_width = true;"
     
105.                    "          } "
     
106.                    "     } "
     
107.                    "     :row"
     
108.                    "     { "
     
109.                    "          :text"
     
110.                    "          { "
     
111.                    "             "
     
112.                    "               label = "之间距离";"
     
113.                    "               fixed_height = true;"
     
114.                    "               fixed_width = true;"
     
115.                    "          } "
     
116.                    "          :edit_box"
     
117.                    "          {"
     
118.                    "               key = "zjjl";"
     
119.                    "               width = 12.15;"
     
120.                    "               height = 0.938;"
     
121.                    "               fixed_height = true;"
     
122.                    "               fixed_width = true;"
     
123.                    "          } "
     
124.                    "     } "
     
125.                    "     :row"
     
126.                    "     { "
     
127.                    "          :text"
     
128.                    "          { "
     
129.                    "              "
     
130.                    "               label = "每行个数";"
     
131.                    "               fixed_height = true;"
     
132.                    "               fixed_width = true;"
     
133.                    "          } "
     
134.                    "          :edit_box"
     
135.                    "          { "
     
136.                    "               key = "mxgs";"
     
137.                    "               width = 12.15;"
     
138.                    "               height = 0.938;"
     
139.                    "               fixed_height = true;"
     
140.                    "               fixed_width = true;"
     
141.                    "          }"
     
142.                    "     }"
     
143.                    "     ok_cancel;"
     
144.                    "} "
     
145.                  )
     
146.   )
     
147.   (setq file (vl-filename-mktemp "DclTemp.dcl"))
     
148.   (setq f (open file "w"))
     
149.   (foreach str lst_str
     
150.     (princ "\n" f)
     
151.     (princ str f)
     
152.   )
     
153.   (close f)
     
154.   file
     
155. )
     
156. (princ)
     

(defun c:tt(/ )<br />   (setq i 1)<br />   (setq ang 0)<br />   (setq n 0)<br />   (main)<br />   (prin1)<br /> )<br /> (defun main( / pt)<br />   (setq dcl_id (load_dialog (make-dcl)))<br />   (new_dialog "gst" dcl_id)<br />   (set_tile "kzkd" "100")<br />   (setq kd(atof(get_tile"kzkd" )))<br />   (set_tile "zjjl" "20")<br />   (set_tile "mxgs" "10")<br />   (setq jl(atof(get_tile"zjjl" )))<br />   (action_tile "dkwj" "(done_dialog 1)")<br />   (setq dd(start_dialog))<br />   (if (= dd 1)<br />     (progn<br />       (find_file)<br />       (if(not pt) (setq pt(getpoint"\n插入点")))<br />       (setq pt: pt)<br />       (foreach   f filelist<br />         (inpic (strcat path"\" f  )pt  )<br />         (setq las(entlast))<br />         (setq bx(box las))<br />         (setq wh(mapcar 'abs (mapcar '- (car bx)(cadr bx))))<br />         (command "SCALE" las"" "non" pt (/ kd (car wh)) )<br />         (setq i(1+ i))<br />         (if (/= (rem  i 11 )1  )<br />           (setq ang 0)<br />           (progn(setq ang (* 0.5 pi))<br />             (setq i 1)<br />             (setq n(1+ n))<br />             (setq pt  (polar pt: ang (* n(* 2 kd))))<br />           )<br />         )<br />         (setq pt  (polar pt ang (+ jl kd)))<br />       )<br />     )<br />   )<br /> )<br /> (defun inpic (path::  pta /)<br />   (vla-AddRaster<br />     (vla-get-modelspace(vla-get-activedocument(vlax-get-acad-object)))<br />     path::<br />     (vlax-3d-point   pta<br />     )<br />     1<br />     0<br />   )<br /> )<br /> (defun box (ss0 / ptmi ptma)<br />   (vla-getboundingbox<br />     (vlax-ename->vla-object ss0)<br />     'ptmi<br />     'ptma<br />   )<br />   (mapcar 'vlax-safearray->list (list ptmi ptma))<br /> )<br /> (defun find_file ()<br />   (setq FILE: (getfiled "选择文件夹内一个文件"<br />                 ""<br />                 ""<br />                 4<br />               )<br />   )<br />   (setq path     (vl-filename-directory FILE:)<br />     filelist (vl-directory-files path "*.jpg")<br />   ))<br /> (defun make-dcl  (/ lst_str str file f)<br />   (setq lst_str '(<br />                    "gst:dialog"<br />                    "{ "<br />                    "     label = "批量插入光栅图";"<br />                    "         :row"<br />                    "     { "<br />                    "          :button"<br />                    "          { "<br />                    "               key = "dkwj";"<br />                    "               label = "打开文件夹";"<br />                    "               width = 12.15;"<br />                    "               height = 1.875;"<br />                    "               fixed_height = true;"<br />                    "               fixed_width = true;"<br />                    "          } "<br />                    "     } "<br />                    "     :row"<br />                    "     {"<br />                    "          :text"<br />                    "          {"<br />                    "              "<br />                    "               label = "图片宽度";"<br />                    "               fixed_height = true;"<br />                    "               fixed_width = true;"<br />                    "          } "<br />                    "          :edit_box"<br />                    "          { "<br />                    "               key = "kzkd";"<br />                    "               width = 12.15;"<br />                    "               height = 0.938;"<br />                    "               fixed_height = true;"<br />                    "               fixed_width = true;"<br />                    "          } "<br />                    "     } "<br />                    "     :row"<br />                    "     { "<br />                    "          :text"<br />                    "          { "<br />                    "             "<br />                    "               label = "之间距离";"<br />                    "               fixed_height = true;"<br />                    "               fixed_width = true;"<br />                    "          } "<br />                    "          :edit_box"<br />                    "          {"<br />                    "               key = "zjjl";"<br />                    "               width = 12.15;"<br />                    "               height = 0.938;"<br />                    "               fixed_height = true;"<br />                    "               fixed_width = true;"<br />                    "          } "<br />                    "     } "<br />                    "     :row"<br />                    "     { "<br />                    "          :text"<br />                    "          { "<br />                    "              "<br />                    "               label = "每行个数";"<br />                    "               fixed_height = true;"<br />                    "               fixed_width = true;"<br />                    "          } "<br />                    "          :edit_box"<br />                    "          { "<br />                    "               key = "mxgs";"<br />                    "               width = 12.15;"<br />                    "               height = 0.938;"<br />                    "               fixed_height = true;"<br />                    "               fixed_width = true;"<br />                    "          }"<br />                    "     }"<br />                    "     ok_cancel;"<br />                    "} "<br />                  )<br />   )<br />   (setq file (vl-filename-mktemp "DclTemp.dcl"))<br />   (setq f (open file "w"))<br />   (foreach str lst_str<br />     (princ "\n" f)<br />     (princ str f)<br />   )<br />   (close f)<br />   file<br /> )<br /> (princ)<br />

jun353835273

可以加个列表框，不需的给移除
DCL搞好了，大佬们来驱动他吧

434939575

jun353835273 发表于 2023-7-26 18:19
可以加个列表框，不需的给移除

没有看到图片不知道是否移除的

xcmdos

谢谢楼主分享，有批量插入PDF页面的方式吗

jun353835273

xcmdos 发表于 2023-7-26 23:59
谢谢楼主分享，有批量插入PDF页面的方式吗

(command "._-pdfattach" PDFFile 页码 坐标  比例 "0")
页码识别参考http://bbs.mjtd.com/thread-187420-1-1.html

依然小小鸟

jun353835273 发表于 2023-7-27 08:18
(command "._-pdfattach" PDFFile 页码 坐标  比例 "0")
页码识别参考http://bbs.mjtd.com/thread-18742 ...

不太懂代码 有整合到一起的代码吗  批量插入PDF

ajunseo

程序不能用

vista228

大佬，程序用不了，输入的列表有缺陷ssget 列表值错误