[源码]LISP实现所见即所得

cabinsummer

在作图过程中，有时需看一下图纸当前状态的打印效果是否能看清细小之处，此程序就可实现这个功能。提取变量Dimscale是为了让图纸真实再现打印效果，比如用1:2比例尺，一般图形都按1:1画，缩小一倍打印。desktop和laptop是显示器的点距参数表，一般的民用显示器点距参数都是一定的。desktop为台式机，laptop为笔记本。表由很多字符串构成，每个字符串代表一种显示器参数。字符"\t"左边为显示器大小，"\t"和"\td"之间为标准显示分辨率，"\td"右边是点距。由于采用了硬件的参数，所以显示比较真实。以前见过一些实现类似功能的程序，但都不精确，在窗口大小不同的情况下运行结果会变化（相对于打印效果），本程序则没有这个问题。

;;;Z11.LSP程序

1. (defun c:z11(/ ctr)
   
2.   (setq ctr (getpoint "<Select central point>\n"))
   
3.   (z11 ctr)
   
4. )
   
5. (defun z11(ctr / desktop laptop DLG_ID llist result pixelpitch zx make_list do_pixelpitch)
   
6.   (setvar "cmdecho" 0)
   
7.   (defun make_list()
   
8.     (start_list "item" 3)
   
9.     (mapcar 'add_list llist)
   
10.     (end_list)
    
11.   )
    
12.   (defun do_pixelpitch()
    
13.     (setq pixelpitch (nth (atoi $value) llist))
    
14.   )
    
15.   (if (not (vl-registry-read "HKEY_CURRENT_USER\\Software\\Freebird" "pixelpitch"))
    
16.     (progn
    
17.       (setq desktop '(
    
18.   "12.1\t800*600\td0.308" "12.1\t1024*768\td0.240" "12.1\t1280*800\td0.204"
    
19.   "13.3\t1024*768\td0.264" "13.3\t1280*800\td0.224" "14.1\t1024*768\td0.279"
    
20.   "14.1\t1280*800\td0.237" "14.1\t1400*1050\td0.204" "14.1\t1440*900\td0.211"
    
21.   "15\t1024*768\td0.297" "15\t1400*1050\td0.218" "15\t1600*1200\td0.190"
    
22.   "16\t1280*1024\td0.248" "17\t1280*1024\td0.264" "17W\t1280*768\td0.2895"
    
23.   "17.4\t1280*1024\td0.270" "18\t1280*1024\td0.281" "19\t1280*1024\td0.294"
    
24.   "19\t1600*1200\td0.242" "19W\t1440*900\td0.285" "19W\t1680*1050\td0.243"
    
25.   "20.1\t1200*1024\td0.312" "20.1\t1600*1200\td0.255" "20.1W\t1680*1050\td0.258"
    
26.   "20.1\t2560*2048\td0.156" "20.8\t2048*1536\td0.207" "21.3\t1600*1200\td0.270"
    
27.   "21.3\t2048*1536\td0.210" "21.6W\t1680*1050\td0.276" "22W\t1600*1024\td0.294"
    
28.   "22W\t1680*1050\td0.282" "22.2\t3840*2400\td0.1245" "23W\t1920*1200\td0.258"
    
29.   "23.1\t1600*1200\td0.294" "24W\t1920*1200\td0.270" "27W\t1920*1200\td0.303"
    
30.   "30W\t2560*1600\td0.250"
    
31.         )
    
32.      laptop '(
    
33.   "12.1\t1024*768\td0.240" "13.3\t1024*768\td0.264" "14.1\t1024*768\td0.280"
    
34.   "15.1\t1024*768\td0.300" "14.1\t1400*1050\td0.205" "15.1\t1400*1050\td0.219"
    
35.   "15.1\t1600*1200\td0.1918" "12.1W\t1280*800\td0.204" "13.3W\t1280*800\td0.224"
    
36.   "14.1W\t1280*800\td0.237" "15.4W\t1280*800\td0.259" "17W\t1280*800\td0.286"
    
37.   "14.1W\t1440*900\td0.211" "15.4W\t1440*900\td0.230" "17W\t1440*900\td0.254"
    
38.   "17W\t1920*1200\td0.191" "19W\t1920*1200\td0.213" "20W\t1920*1200\td0.224"
    
39.         )
    
40.       )
    
41.       (setq DLG_ID (load_dialog "screen.dcl"))
    
42.       (new_dialog "screen" DLG_ID)
    
43.       (setq llist laptop)
    
44.       (make_list)
    
45.       (action_tile "LAP" "(setq llist laptop)(make_list)")
    
46.       (action_tile "DESK" "(setq llist desktop)(make_list)")
    
47.       (action_tile "item" "(do_pixelpitch)")
    
48.       (action_tile "accept" "(done_dialog 1)(setq result T)")
    
49.       (action_tile "cancel" "(done_dialog 0)")
    
50.       (start_dialog)
    
51.       (unload_dialog DLG_ID)
    
52.       (if result
    
53.         (progn
    
54.           (setq pixelpitch (substr pixelpitch (+ (vl-string-position 100 pixelpitch) 2)))
    
55.           (vl-registry-write "HKEY_CURRENT_USER\\Software\\Freebird" "pixelpitch" pixelpitch)
    
56.         )
    
57.       )
    
58.     )
    
59.   )
    
60.   (setq pixelpitch (distof (vl-registry-read "HKEY_CURRENT_USER\\Software\\Freebird" "pixelpitch") 2))
    
61.   (setq zx (strcat (rtos (/ (getvar "viewsize") (getvar "dimscale") (nth 1 (getvar "screensize")) pixelpitch) 2 4) "X"))
    
62.   (command "zoom" "c" ctr "")
    
63.   (command "zoom" "s" (eval zx))
    
64.   (princ)
    
65. )

(defun c:z11(/ ctr)<br />   (setq ctr (getpoint "<Select central point>\n"))<br />   (z11 ctr)<br /> )<br /> (defun z11(ctr / desktop laptop DLG_ID llist result pixelpitch zx make_list do_pixelpitch)<br />   (setvar "cmdecho" 0)<br />   (defun make_list()<br />     (start_list "item" 3)<br />     (mapcar 'add_list llist) <br />     (end_list)<br />   )<br />   (defun do_pixelpitch()<br />     (setq pixelpitch (nth (atoi $value) llist))<br />   )<br />   (if (not (vl-registry-read "HKEY_CURRENT_USER\\Software\\Freebird" "pixelpitch"))<br />     (progn<br />       (setq desktop '(<br />   "12.1\t800*600\td0.308" "12.1\t1024*768\td0.240" "12.1\t1280*800\td0.204"<br />   "13.3\t1024*768\td0.264" "13.3\t1280*800\td0.224" "14.1\t1024*768\td0.279"<br />   "14.1\t1280*800\td0.237" "14.1\t1400*1050\td0.204" "14.1\t1440*900\td0.211"<br />   "15\t1024*768\td0.297" "15\t1400*1050\td0.218" "15\t1600*1200\td0.190"<br />   "16\t1280*1024\td0.248" "17\t1280*1024\td0.264" "17W\t1280*768\td0.2895"<br />   "17.4\t1280*1024\td0.270" "18\t1280*1024\td0.281" "19\t1280*1024\td0.294"<br />   "19\t1600*1200\td0.242" "19W\t1440*900\td0.285" "19W\t1680*1050\td0.243"<br />   "20.1\t1200*1024\td0.312" "20.1\t1600*1200\td0.255" "20.1W\t1680*1050\td0.258"<br />   "20.1\t2560*2048\td0.156" "20.8\t2048*1536\td0.207" "21.3\t1600*1200\td0.270"<br />   "21.3\t2048*1536\td0.210" "21.6W\t1680*1050\td0.276" "22W\t1600*1024\td0.294"<br />   "22W\t1680*1050\td0.282" "22.2\t3840*2400\td0.1245" "23W\t1920*1200\td0.258"<br />   "23.1\t1600*1200\td0.294" "24W\t1920*1200\td0.270" "27W\t1920*1200\td0.303"<br />   "30W\t2560*1600\td0.250"<br />         )<br />      laptop '(<br />   "12.1\t1024*768\td0.240" "13.3\t1024*768\td0.264" "14.1\t1024*768\td0.280"<br />   "15.1\t1024*768\td0.300" "14.1\t1400*1050\td0.205" "15.1\t1400*1050\td0.219"<br />   "15.1\t1600*1200\td0.1918" "12.1W\t1280*800\td0.204" "13.3W\t1280*800\td0.224"<br />   "14.1W\t1280*800\td0.237" "15.4W\t1280*800\td0.259" "17W\t1280*800\td0.286"<br />   "14.1W\t1440*900\td0.211" "15.4W\t1440*900\td0.230" "17W\t1440*900\td0.254"<br />   "17W\t1920*1200\td0.191" "19W\t1920*1200\td0.213" "20W\t1920*1200\td0.224"<br />         )<br />       )<br />       (setq DLG_ID (load_dialog "screen.dcl"))<br />       (new_dialog "screen" DLG_ID)<br />       (setq llist laptop)<br />       (make_list)<br />       (action_tile "LAP" "(setq llist laptop)(make_list)")<br />       (action_tile "DESK" "(setq llist desktop)(make_list)")<br />       (action_tile "item" "(do_pixelpitch)")<br />       (action_tile "accept" "(done_dialog 1)(setq result T)")<br />       (action_tile "cancel" "(done_dialog 0)")<br />       (start_dialog)<br />       (unload_dialog DLG_ID)<br />       (if result<br />         (progn<br />           (setq pixelpitch (substr pixelpitch (+ (vl-string-position 100 pixelpitch) 2)))<br />           (vl-registry-write "HKEY_CURRENT_USER\\Software\\Freebird" "pixelpitch" pixelpitch)<br />         )<br />       )<br />     )<br />   )<br />   (setq pixelpitch (distof (vl-registry-read "HKEY_CURRENT_USER\\Software\\Freebird" "pixelpitch") 2))<br />   (setq zx (strcat (rtos (/ (getvar "viewsize") (getvar "dimscale") (nth 1 (getvar "screensize")) pixelpitch) 2 4) "X"))<br />   (command "zoom" "c" ctr "")<br />   (command "zoom" "s" (eval zx))<br />   (princ)<br /> )

;;;SCREEN.DCL文件

1. screen : dialog
   
2. {
   
3.   label = "Developed by Freebird";
   
4.   :row
   
5.   {
   
6.     :radio_button
   
7.     {
   
8.       label="LAPTOP";
   
9.       key="LAP";
   
10.       value=1;
    
11.       width=1;
    
12.     }
    
13.     :radio_button
    
14.     {
    
15.       label="DESKTOP";
    
16.       key="DESK";
    
17.       value=0;
    
18.       width=1;
    
19.     }
    
20.   }
    
21.   :list_box
    
22.   {
    
23.     key="item";
    
24.     value=0;
    
25.     width=20;
    
26.     height=20;
    
27.     allow_accept=true;
    
28.     tabs = "16 40";
    
29.   }
    
30.   ok_cancel;
    
31. }

screen : dialog<br /> {<br />   label = "Developed by Freebird";<br />   :row<br />   {<br />     :radio_button<br />     {<br />       label="LAPTOP";<br />       key="LAP";<br />       value=1;<br />       width=1;<br />     }<br />     :radio_button<br />     {<br />       label="DESKTOP";<br />       key="DESK";<br />       value=0;<br />       width=1;<br />     }<br />   }<br />   :list_box<br />   {<br />     key="item";<br />     value=0;<br />     width=20;<br />     height=20;<br />     allow_accept=true;<br />     tabs = "16 40"; <br />   }<br />   ok_cancel;<br /> }

GSD

cabinsummer 发表于 2011-9-2 18:53
公式已经在帖子上了，你可以找数学好的帮忙。
点距＝显示器对角线尺寸(mm)/SQRT(宽方向点数的平方＋高方 ...

首先表示感谢！！
授人以鱼不如授人以渔！！版主讲的很详细！
添加了自己的显示器尺寸
本人估计是杂牌显示器！ 对角尺寸为597毫米，分辨率为1920x1080
计算得出：点距为0.27096 已经测试成功，很好用！！！！！！！！！！！

slq803

谢谢楼主分享，终于不用在总是打印出来以后看效果了，非常感谢

flythinking

谢谢大师分享

cabinsummer

没人回复，自己顶

戏男

我顶你 不错的方法 谢谢

戏男

我试了 出错 显示; 错误: 参数类型错误: stringp nil

cabinsummer

显示对话框了吗？

zhuangxu_521

出错呀

cabinsummer

对不起大家，在LSP文件（绿色）的倒数第六行有（getvar "dimscale"）我误把中文字符的括号"（" "）"加上了，改成英文的"(" ")"就好了。能用之后，请大家回个贴，谢谢！

xotoo

没有出现对话框
出现一个命令提示
但命令运行无效果
建议楼主重新编译一下然后发布上来

xotoo

没有出现对话框
出现一个命令提示
但命令运行无效果
建议楼主重新编译一下然后发布上来

cabinsummer

我已经编译了，附件包含编译后的VLX文件和源程序及对话框文件。试成功后，请回帖