制作幻灯片MSLIDE

/db_自贡黄明儒_

1. ;;制作幻灯片MSLIDE
   
2. ;;我的对话框一般相当简单，有一次加入幻灯片，结果费了九条牛和两只虎的气力，在大家的帮助下才完成。
   
3. ;;用度娘和本论坛搜索，lisp版的管理幻灯片管理当属虾版和晨雨的了，但没有幻灯片的制作。
   
4. ;;下面用highflybird大师的选择集最小包围盒，然后用marting的方法缩放窗口，制作幻灯片，初步到达效果，但
   
5. ;;还存在如下问题，希望有好心人能解决
   
6. ;;1 对话框上image控件的x y之比例，显然同窗口比例不同
   
7. ;;2 最小包围盒边界上的东西会丢失
   
8. (defun C:sld (/ DH DW H PTS SIZE SS V W)
   
9.   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))
   
10.   (or *DOC* (setq *DOC* (vla-get-activedocument)))
    
11.   (if (ssget)
    
12.     (progn
    
13.       (setq ss (vla-get-ActiveSelectionSet *DOC*))
    
14.       (setq pts (SC:SSBox1 ss))
    
15.       (setq v (apply 'mapcar (cons '- pts)))
    
16.       (setq w 400);(getvar "screensize")一致
    
17.       (setq s (/ (cadr v) (car v)))
    
18.       (princ"\n 图像框长宽比最好接近")
    
19.       (princ s)
    
20.       (setq h (* S w))
    
21.       (setq SIZE (getvar "SCREENSIZE"))
    
22.       (setq dw (- (vla-get-width *DOC*) (car SIZE)))
    
23.       (setq dh (- (vla-get-Height *DOC*) (cadr SIZE)))
    
24.       (vla-put-width *DOC* (+ dw w))
    
25.       (vla-put-height *DOC* (+ dh h))
    
26.       (vla-Update *ACAD*)
    
27.       ;;pts可能在屏幕之外
    
28.       (vla-ZoomAll *ACAD*)
    
29.       (getpoint "\n 在屏中点取一下");这里好像有问题，但不知？？？
    
30.       (apply 'vla-zoomwindow
    
31.              (cons *ACAD* (mapcar 'vlax-3d-point pts))
    
32.       )
    
33.       ;;(command "cecolor" "")
    
34.       (command "._MSLIDE" "E:\\111.sld")
    
35.     )
    
36.   )
    
37.   (princ)
    
38. )
    
39. 
    
40. ;;test是测试文件
    
41. (defun C:test (/ DCLID FN FNAME RETURN#)
    
42.   (setq fname (vl-filename-mktemp nil nil ".dcl"))
    
43.   (setq fn (open fname "w"))
    
44.   (write-line "ppp : dialog {" fn)
    
45.   (write-line "  key = \"Title\";" fn)
    
46.   (write-line "  label = \"\";" fn)
    
47.   (write-line "  spacer;" fn)
    
48.   (write-line "  " fn)
    
49.   (write-line "    : image {" fn)
    
50.   (write-line "      alignment = centered;" fn)
    
51.   (write-line "      key = \"Image\";" fn)
    
52.   (write-line "      width = 20;//101" fn)
    
53.   (write-line "      height = 20;//43" fn)
    
54.   (write-line "      fixed_width = true;" fn)
    
55.   (write-line "      fixed_height = true;" fn)
    
56.   (write-line "      aspect_ratio = 1;" fn)
    
57.   (write-line "      color = -2;" fn)
    
58.   (write-line "    }" fn)
    
59.   (write-line "  " fn)
    
60.   (write-line "  : ok_button {is_cancel = true;}" fn)
    
61.   (write-line "}" fn)
    
62.   (close fn)
    
63. 
    
64.   (setq dclid (load_dialog fname))
    
65. 
    
66.   (new_dialog "ppp" dclid)
    
67.   (MJ:loadsld "Image" (findfile "111.sld"))
    
68.   (action_tile "accept" "(done_dialog 1)")
    
69.   (setq return# (start_dialog))
    
70. 
    
71.   (unload_dialog dclid)
    
72.   (vl-file-delete fname)
    
73.   (princ)
    
74. )
    
75. 
    
76. ;;140 [功能] 加载幻灯片（见183.5)
    
77. ;;(MJ:loadsld "Key1" (findfile "HHZQ.sld"))
    
78. (defun MJ:loadsld (key sld / x y)
    
79.   (setq        x (dimx_tile key)
    
80.         y (dimy_tile key)
    
81.   )
    
82.   (start_image key)
    
83.   (fill_image 0 0 x y -2)
    
84.   (slide_image 0 0 x y sld)
    
85.   (end_image)
    
86. )
    
87. 
    
88. ;;highflybird选择集包围盒
    
89. (defun SC:SSBox1 (ss / ISUCS MAXPT MAXPTS MINPT MINPTS U2W W2U)
    
90.   (setq IsUCS (zerop (getvar "WORLDUCS")))                                                  ;nil世界
    
91.   (cond (IsUCS (setq w2u (MAT:w2u)) (setq u2w (MAT:u2w))))
    
92.   (vlax-for obj        ss
    
93.     (and IsUCS (vla-TransformBy obj (vlax-tmatrix w2u)))
    
94.     (vla-GetBoundingBox obj 'MinPt 'MaxPt)
    
95.     (setq MinPt (vlax-safearray->list MinPt))
    
96.     (setq MaxPt (vlax-safearray->list MaxPt))
    
97.     (setq MinPts (cons MinPt MinPts))
    
98.     (setq MaxPts (cons MaxPt MaxPts))
    
99.     (and IsUCS (vla-TransformBy obj (vlax-tmatrix u2w)))
    
100.   )
     
101.   (list
     
102.     (apply 'mapcar (cons 'min minpts))
     
103.     (apply 'mapcar (cons 'max MaxPts))
     
104.   )
     
105. )
     

;;制作幻灯片MSLIDE<br /> ;;我的对话框一般相当简单，有一次加入幻灯片，结果费了九条牛和两只虎的气力，在大家的帮助下才完成。<br /> ;;用度娘和本论坛搜索，lisp版的管理幻灯片管理当属虾版和晨雨的了，但没有幻灯片的制作。<br /> ;;下面用highflybird大师的选择集最小包围盒，然后用marting的方法缩放窗口，制作幻灯片，初步到达效果，但<br /> ;;还存在如下问题，希望有好心人能解决<br /> ;;1 对话框上image控件的x y之比例，显然同窗口比例不同<br /> ;;2 最小包围盒边界上的东西会丢失<br /> (defun C:sld (/ DH DW H PTS SIZE SS V W)<br />   (or *ACAD* (setq *ACAD* (vlax-get-acad-object)))<br />   (or *DOC* (setq *DOC* (vla-get-activedocument)))<br />   (if (ssget)<br />     (progn<br />       (setq ss (vla-get-ActiveSelectionSet *DOC*))<br />       (setq pts (SC:SSBox1 ss))<br />       (setq v (apply 'mapcar (cons '- pts)))<br />       (setq w 400);(getvar "screensize")一致<br />       (setq s (/ (cadr v) (car v)))<br />       (princ"\n 图像框长宽比最好接近")<br />       (princ s)<br />       (setq h (* S w))<br />       (setq SIZE (getvar "SCREENSIZE"))<br />       (setq dw (- (vla-get-width *DOC*) (car SIZE)))<br />       (setq dh (- (vla-get-Height *DOC*) (cadr SIZE)))<br />       (vla-put-width *DOC* (+ dw w))<br />       (vla-put-height *DOC* (+ dh h))<br />       (vla-Update *ACAD*)<br />       ;;pts可能在屏幕之外<br />       (vla-ZoomAll *ACAD*)<br />       (getpoint "\n 在屏中点取一下");这里好像有问题，但不知？？？<br />       (apply 'vla-zoomwindow<br />              (cons *ACAD* (mapcar 'vlax-3d-point pts))<br />       )<br />       ;;(command "cecolor" "")<br />       (command "._MSLIDE" "E:\\111.sld")<br />     )<br />   )<br />   (princ)<br /> )<br /> <br /> ;;test是测试文件<br /> (defun C:test (/ DCLID FN FNAME RETURN#)<br />   (setq fname (vl-filename-mktemp nil nil ".dcl"))<br />   (setq fn (open fname "w"))<br />   (write-line "ppp : dialog {" fn)<br />   (write-line "  key = \"Title\";" fn)<br />   (write-line "  label = \"\";" fn)<br />   (write-line "  spacer;" fn)<br />   (write-line "  " fn)<br />   (write-line "    : image {" fn)<br />   (write-line "      alignment = centered;" fn)<br />   (write-line "      key = \"Image\";" fn)<br />   (write-line "      width = 20;//101" fn)<br />   (write-line "      height = 20;//43" fn)<br />   (write-line "      fixed_width = true;" fn)<br />   (write-line "      fixed_height = true;" fn)<br />   (write-line "      aspect_ratio = 1;" fn)<br />   (write-line "      color = -2;" fn)<br />   (write-line "    }" fn)<br />   (write-line "  " fn)<br />   (write-line "  : ok_button {is_cancel = true;}" fn)<br />   (write-line "}" fn)<br />   (close fn)<br /> <br />   (setq dclid (load_dialog fname))<br /> <br />   (new_dialog "ppp" dclid)<br />   (MJ:loadsld "Image" (findfile "111.sld"))<br />   (action_tile "accept" "(done_dialog 1)")<br />   (setq return# (start_dialog))<br /> <br />   (unload_dialog dclid)<br />   (vl-file-delete fname)<br />   (princ)<br /> )<br /> <br /> ;;140 [功能] 加载幻灯片（见183.5)<br /> ;;(MJ:loadsld "Key1" (findfile "HHZQ.sld"))<br /> (defun MJ:loadsld (key sld / x y)<br />   (setq        x (dimx_tile key)<br />         y (dimy_tile key)<br />   )<br />   (start_image key)<br />   (fill_image 0 0 x y -2)<br />   (slide_image 0 0 x y sld)<br />   (end_image)<br /> )<br /> <br /> ;;highflybird选择集包围盒<br /> (defun SC:SSBox1 (ss / ISUCS MAXPT MAXPTS MINPT MINPTS U2W W2U)<br />   (setq IsUCS (zerop (getvar "WORLDUCS")))                                                  ;nil世界<br />   (cond (IsUCS (setq w2u (MAT:w2u)) (setq u2w (MAT:u2w))))<br />   (vlax-for obj        ss<br />     (and IsUCS (vla-TransformBy obj (vlax-tmatrix w2u)))<br />     (vla-GetBoundingBox obj 'MinPt 'MaxPt)<br />     (setq MinPt (vlax-safearray->list MinPt))<br />     (setq MaxPt (vlax-safearray->list MaxPt))<br />     (setq MinPts (cons MinPt MinPts))<br />     (setq MaxPts (cons MaxPt MaxPts))<br />     (and IsUCS (vla-TransformBy obj (vlax-tmatrix u2w)))<br />   )<br />   (list<br />     (apply 'mapcar (cons 'min minpts))<br />     (apply 'mapcar (cons 'max MaxPts))<br />   )<br /> )<br />

newer

比例不同，你可以通过建立对应比例的视窗，在里面ZOOM E后，在适当缩小一点。

/db_自贡黄明儒_

newer 发表于 2017-6-16 22:01

不行呀，比如窗口长高是2：1，image控件x y之比也是2:1,显示出来也是没有填满的。

newer

/db_自贡黄明儒_ 发表于 2017-6-16 22:19

ZOOM E下，至少有一个方向是填满的吧

sicky111

谢谢分享。

/db_自贡黄明儒_

newer 发表于 2017-6-16 23:10

这段文字好像是在说DCL的image长宽的问题，但不明白为什么下面是6和13
; GetPT [Get integer Points] - Utility for vector_line.
; Returns: Positive X and Y integer points to cut and paste into a list for
; vector_line or as X and Y integer points for vector_image.
; Note: This function is used to create vector images. The origin point 0,0 in
; an image tile is in the upper left corner. The height and width in the DCL
; file determine the values of the dimx_tile and dimy_tile in the AutoLISP file.
; The values of the dimx_tile and dimy_tile are one greater than the drawing
; limits of the image tile pixels. To create a 100 x 100 pixel image, draw a
; rectangle from 0,0 to 99,-99. Copy and scale the entities you want to include
; in your image into the limits of the outlined rectangle.
; Based upon a 100 dimx_tile x 100 dimy_tile image tile you may calculate:
;   DCL width  = (+ (* (1- 100)(/ 1 6.0)) 0.09) = 16.59
;   DCL height = (+ (* (1- 100)(/ 1 13.0)) 0.048) =  7.66
; As a guide while picking points, set the snap to 1.
; Below is the dialog width and height values for the following:
;   For a 10 x 10 pixel image:   width = 1.59, height = 0.74
;   For a 25 x 25 pixel image:   width = 4.09, height = 1.89
;   For a 32 x 32 pixel image:   width = 5.26, height = 2.43
;   For a 50 x 50 pixel image:   width = 8.26, height = 3.82
;   For a 100 x 100 pixel image: width = 16.59, height = 7.66
;   For a 200 x 200 pixel image: width = 33.26. height = 15.36
;   For a 400 x 400 pixel image: width = 66.59, height = 30.74
;   For a 500 x 500 pixel image: width = 83.26, height = 38.43
; These values are based an a 1024 x 768 screen area and may vary according
; to individual screen resolutions.

Lisphk

newer 发表于 2017-6-16 23:10

你另外一个方向也填满，如果你的窗口的比例和 对象包围盒的比例 不 近似的话，那你的图还不变形了啊
黄总，不能做个窗口的比例近似你的 对象长宽比例的吗？

/db_自贡黄明儒_

晓东的高手哪里去了？忍心看我在这儿瞎忙碌？
我猜想，image上x y 一比一时显示是方的，那么就要使用变量screensize了，如果真是这样，上面问题就完美解决了

Lisphk

/db_自贡黄明儒_ 发表于 2017-6-17 14:21

黄总，你制作前的对象的样子是什么， 制作后显示到对话框里面的又是什么样子的，能截取两个图贴上来吗？

/db_自贡黄明儒_

现在终于清楚了，上面的程序本来就是很完整的

fengyun7000

超级难看，就是没找到好的制作软件

tengteb

还有一种思路：根据界面和幻灯片的内容，先确定尺寸，CAD中在对象外画对应尺寸的框，然后把绘图窗口设置为对应的尺寸，再ZOOM，选择对象“框”，最后MSLIDE就可以了。

huangpc27

好方法，非常不错