[CAD插件分享] 分享两款实用小工具

hebps

分享两款实用小工具，赚点币回回血～

【影像插入工具】 支持带坐标文件的TIF，JPG影像图插入！

【CAD优化加速】 针对老CAD 优化启动速度，禁用 通讯中心，删除 FTPSites 共享站点 和 ACPROJECT 联机协作，取消IE检查证书等！

yanshengjiang

2. (defun c:in()
   
3.   
   
4.   (VL-LOAD-COM)
   
5. 
   
6.   (setq AcadObject(vlax-get-acad-object)
   
7. 
   
8.         AcadDocument(vla-get-ActiveDocument Acadobject)
   
9. 
   
10.         mSpace(vla-get-ModelSpace Acaddocument)
    
11.   )
    
12. 
    
13.   (setq imageName (getfiled "指定政区数据文件" (getvar "DWGPREFIX") "jpg;tif" 2))
    
14. 
    
15. ;;; 读取并计算tfw文件参数
    
16. (if(null(findfile(setq tfwname (strcat (substr imageName 1 (- (strlen imageName) 3)) "tfw"))))
    
17.   (setq tfwname (strcat (substr imageName 1 (- (strlen imageName) 3)) "jgw"))
    
18.   )
    
19.    
    
20.   (setq fp (open tfwname "r"))  
    
21.   (setq reco (read-line fp) ii 1)
    
22.   (setq chat nil)                  
    
23.   (while reco
    
24.      (setq chat (append (list reco) chat))             
    
25.      (setq reco (read-line fp) ii (1+ ii))                     
    
26.    )  ;end while
    
27.   (close fp)
    
28. 
    
29.   (setq pt (list (atof (nth 1 chat)) (atof (nth 0 chat)) 0))
    
30.   (setq bl (atof (nth 5 chat)))
    
31. 
    
32.   (setq insertionPnt(vlax-make-safearray vlax-vbDouble '(0 . 2)))
    
33. 
    
34.   (vlax-safearray-fill insertionPnt pt )
    
35. 
    
36. ;;; 在模型空间中建立一个光栅图像
    
37. 
    
38.   (setq RasterObj(vla-AddRaster mSpace imageName insertionPnt 1 0))
    
39. 
    
40.   (setq width (vla-get-Width RasterObj))
    
41.   (setq height (vla-get-height RasterObj))
    
42. 
    
43.   (vla-put-ImageWidth RasterObj (* width bl))
    
44.   (vla-put-Imageheight RasterObj (* height bl))
    
45.   (command "move" (entlast) "" (list 0 (* height bl)) (list 0 0))
    
46. 
    
47.   (command "zoom" "e" "zoom" "0.8x")
    
48. 
    
49. )
    
50. 
    
51.      
    
52.               一样的吗？

(defun c:in()<br />   <br />   (VL-LOAD-COM)<br /> <br />   (setq AcadObject(vlax-get-acad-object)<br /> <br />         AcadDocument(vla-get-ActiveDocument Acadobject)<br /> <br />         mSpace(vla-get-ModelSpace Acaddocument)<br />   )<br /> <br />   (setq imageName (getfiled "指定政区数据文件" (getvar "DWGPREFIX") "jpg;tif" 2))<br /> <br /> ;;; 读取并计算tfw文件参数<br /> (if(null(findfile(setq tfwname (strcat (substr imageName 1 (- (strlen imageName) 3)) "tfw"))))<br />   (setq tfwname (strcat (substr imageName 1 (- (strlen imageName) 3)) "jgw"))<br />   )<br />    <br />   (setq fp (open tfwname "r"))  <br />   (setq reco (read-line fp) ii 1)<br />   (setq chat nil)                   <br />   (while reco<br />      (setq chat (append (list reco) chat))             <br />      (setq reco (read-line fp) ii (1+ ii))                     <br />    )  ;end while <br />   (close fp)<br /> <br />   (setq pt (list (atof (nth 1 chat)) (atof (nth 0 chat)) 0))<br />   (setq bl (atof (nth 5 chat)))<br /> <br />   (setq insertionPnt(vlax-make-safearray vlax-vbDouble '(0 . 2))) <br /> <br />   (vlax-safearray-fill insertionPnt pt )<br /> <br /> ;;; 在模型空间中建立一个光栅图像<br /> <br />   (setq RasterObj(vla-AddRaster mSpace imageName insertionPnt 1 0))<br /> <br />   (setq width (vla-get-Width RasterObj))<br />   (setq height (vla-get-height RasterObj))<br /> <br />   (vla-put-ImageWidth RasterObj (* width bl))<br />   (vla-put-Imageheight RasterObj (* height bl))<br />   (command "move" (entlast) "" (list 0 (* height bl)) (list 0 0))<br /> <br />   (command "zoom" "e" "zoom" "0.8x")<br /> <br /> )<br /> <br />      <br />               一样的吗？

molen123

有用，感谢分享

hebps

molen123 发表于 2026-1-6 14:11
有用，感谢分享

感谢支持！

q530496591

感谢分享。优化加速已下载  因为我经常有死机的烦恼。另外一个提示错误！未找到正射影像坐标文件。我的文件是放在I盘上的。（加速硬盘）。也有可能是我电脑的问题  楼主不要生气。

hebps

q530496591 发表于 2026-1-6 15:13
感谢分享。优化加速已下载  因为我经常有死机的烦恼。另外一个提示错误！未找到正射影像坐标文件。我的文件 ...

正射影像坐标文件需要跟您影像文件在同一目录并且文件名称一致才行！

例如：

paulpipi

有新意，感谢分享

nzdog

不错，谢谢分享支持

MXS

想知道2014版cad可以用这个优化加速吗

hebps

yanshengjiang 发表于 2026-1-7 17:56

感谢大神分享源码，您这个比我哪个好！效果一样的