设为首页收藏本站CAD论坛CAD教程CAD下载明经币充值
切换到宽版

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 【Gu_xl】DWG图形到DCL IMAGE图像描点程序应用源码示例
12345678910... 24下一页
返回列表 发新帖
查看: 78006|回复: 240

[【Gu_xl】] 【Gu_xl】DWG图形到DCL IMAGE图像描点程序应用源码示例

  [复制链接]
Gu_xl
发表于 2011-5-20 15:45:42 | 显示全部楼层 |阅读模式
本帖最后由 Gu_xl 于 2013-6-11 10:43 编辑

DWG到IMAGE图像描点程序有很多人研究过，但没有人公布全部源码！
我将我写的描点程序源码公布出来，供大家学习研究！









该贴已经同步到 Gu_xl的微博

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
"觉得好，就打赏"
打赏
还没有人打赏，支持一下

本帖被以下淘专辑推荐:

回复

使用道具 举报

自贡黄明儒
发表于 2012-7-16 16:35:58 | 显示全部楼层
G版呀！你能不能举个应用示例。看到你这个程序，觉得是个好东西，可以用来做界面，就是悟不透呀。你就好事做到底，送佛送到西，举个应用示例嘛。
回复 支持 1 反对 0

使用道具 举报

尘缘一生
发表于 2020-2-16 02:53:27 | 显示全部楼层
自贡黄明儒 发表于 2012-7-16 18:27
;;; (startapp "notepad.exe" filename)前面的;去掉
;;  Result Wpixel cols Hpixel rows都需要以常量的方 ...



本帖相信没几个人搞的懂，你得程序有这些东西？解释下道理吧？

既然发这个了，大家都不知道怎么用，还有什么意思。

本帖子中包含更多资源

您需要 登录 才可以下载或查看，没有账号？注册

x
回复 支持 反对

使用道具 举报

maxli
发表于 2018-11-4 12:18:50 | 显示全部楼层
egos 发表于 2011-5-20 17:49
http://web2.airmail.net/terrycad网站的 GetVectors.lsp这个不错  能同时生成DCL文件和lsp文件

可以把源码发上来么？我找 了半天没有看到你说的那个程序
回复 支持 反对

使用道具 举报

xshrimp
发表于 2011-5-20 16:50:34 | 显示全部楼层
本帖最后由 xshrimp 于 2011-5-20 16:52 编辑

以前我也写过.现在找不到了.
有好多公布过源码啊.
http://web2.airmail.net/terrycad网站的 GetVectors.lsp
还有下面的不知道谁写的了.

  3. (defun c:Mimage2 (/ BackGround Colors DclFile DclList Dist DxfData Entity Height HeightY Inside LastEntity Line LowerRight LspFile LspList Number Objects Pt SaveOsmode UpperLeft Width WidthX WmfFile X X1s X2s XY Y Y1s Y2s)
  4.   (princ "\nMimage makes an image file for a dialog image tile.") (setvar "cmdecho" 0) (redraw)
  5.   (setq UpperLeft (nth 0 (ViewPoints)) LowerRight (nth 1 (ViewPoints)) Width (nth 2 (ViewPoints)) Height (nth 3 (ViewPoints)))
  6.   (if (not *X) (setq *X (fix (+ 0.5 (* 100 (/ Width (float Height)))))))
  7.   (if (not *Y) (setq *Y 100))
  8.   (if (not (setq X (getint (strcat "\nEnter dimx_tile value <" (itoa *X) ">: ")))) (setq X *X))
  9.   (if (not (setq Y (getint (strcat "\nEnter dimy_tile value <" (itoa *Y) ">: ")))) (setq Y *Y))
  10.   (if (or (< X 2) (< Y 2))
  11.     (progn (princ "\nThe dimx_tile and dimy_tile values must be greater than 1.") (exit))
  12.     (setq *X X *Y Y)
  13.   )
  14.   (if (< (/ X (float Y)) (/ Width Height))
  15.     (setq Dist (* Height (/ X (float Y))) Pt (list (+ (car UpperLeft) Dist) (cadr LowerRight)))
  16.     (setq Dist (* Width (/ Y (float X))) Pt (list (car LowerRight) (- (cadr UpperLeft) Dist)))
  17.   )
  18.   (grdraw UpperLeft (list (car UpperLeft) (cadr Pt)) 1) (grdraw (list (car UpperLeft) (cadr Pt)) Pt 1)
  19.   (grdraw Pt (list (car Pt) (cadr UpperLeft)) 1) (grdraw (list (car Pt) (cadr UpperLeft)) UpperLeft 1)
  20.   (initget "Yes No") (setq Inside (getkword "\nAre the image objects inside the red outline? [Yes/No] <Y>: "))
  21.   (if (= Inside "No") (progn (princ "\nPan or zoom as required, then run the program again.") (exit)))
  22.   (initget "Yes No") (setq BackGround (getkword "\nDo you want an image background? [Yes/No] <Y>: "))
  23.   (setq BackGround (if (= BackGround "No") "    color = -15;" "    color = -2;"))
  24.   (princ "\nCreating image file...") (princ)
  25.   (if (setq Objects (ssget "c" UpperLeft Pt))
  26.     (progn
  27.       (setq WmfFile (vl-filename-mktemp "Temp.wmf") XY (list X (* Y -1)))
  28.       (command "wmfout" WmfFile Objects "" "undo" "begin" "zoom" "0,0" XY)
  29.       (setq LastEntity (entlast) SaveOsmode (getvar "osmode")) (setvar "osmode" 0)
  30.       (command "wmfin" WmfFile "0,0" 2 2 0) (setvar "osmode" SaveOsmode)
  31.       (setq Entity (entlast)) (command "explode" Entity)
  32.       (while (setq Entity (entnext Entity))
  33.         (if (= (cdr (assoc 0 (entget Entity))) "POLYLINE") (command "explode" Entity))
  34.       )
  35.       (setq Entity LastEntity)
  36.       (while (setq Entity (entnext Entity))
  37.         (setq DxfData (entget Entity))
  38.         (if (= (cdr (assoc 0 DxfData)) "LINE")
  39.           (progn
  40.             (setq X1s (append X1s (list (fix (cadr (assoc 10 DxfData))))))
  41.             (setq Y1s (append Y1s (list (fix (abs (caddr (assoc 10 DxfData)))))))
  42.             (setq X2s (append X2s (list (fix (cadr (assoc 11 DxfData))))))
  43.             (setq Y2s (append Y2s (list (fix (abs (caddr (assoc 11 DxfData)))))))
  44.             (setq Colors (append Colors (list (cdr (assoc 62 DxfData)))))
  45.           )
  46.         )
  47.       )
  48.       (command "undo" "end" "undo" 1)
  49.     )
  50.   )
  51.   (setq WidthX (rtos (+ (* (1- X) (/ 1 6.0)) 0.09) 2 2) HeightY (rtos (+ (* (1- Y) (/ 1 13.0)) 0.048) 2 2))
  52.   (setq DclList (list "Vimage : dialog {" "  label = "Vimage Preview"; spacer;" "  : image {" "    key = "image1";" "    alignment = centered;" (strcat "    width = " WidthX ";") "    fixed_width = true;" (strcat "    height = " HeightY ";") "    fixed_height = true;" BackGround "  }" "  ok_only;" "}"))
  53.   (setq DclFile (open (strcat *VimageFolder "Vimage.dcl") "w"))
  54.   (foreach Line DclList (write-line Line DclFile)) (close DclFile)
  55.   (setq LspList (list "(defun Vimage (/ DclID)" "  (setq DclID (load_dialog (strcat *VimageFolder "Vimage.dcl")))" "  (new_dialog "Vimage" DclID)" "  (image1)" "  (princ (strcat "\\ndimx_tile = " (itoa (dimx_tile "image1")) ", dimy_tile = " (itoa (dimy_tile "image1")))) (princ)" "  (start_dialog)" "  (unload_dialog DclID)" "  (princ)" ")" "(defun image1 ()" "  (start_image "image1")"))
  56.   (if Objects
  57.     (progn
  58.       (setq LspList (append LspList (list "  (mapcar 'vector_image")))
  59.       (setq Line "    (list") (foreach Number X1s (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
  60.       (setq LspList (append LspList (list Line)))
  61.       (setq Line "    (list") (foreach Number Y1s (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
  62.       (setq LspList (append LspList (list Line)))
  63.       (setq Line "    (list") (foreach Number X2s (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
  64.       (setq LspList (append LspList (list Line)))
  65.       (setq Line "    (list") (foreach Number Y2s (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
  66.       (setq LspList (append LspList (list Line)))
  67.       (setq Line "    (list") (foreach Number Colors (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
  68.       (setq LspList (append LspList (list Line "  )")))
  69.     )
  70.   )
  71.   (setq LspList (append LspList (list "  (end_image)" ")")))
  72.   (setq LspFile (open (strcat *VimageFolder "Vimage.lsp") "w"))
  73.   (foreach Line LspList (write-line Line LspFile)) (close LspFile)
  74.   (princ " Complete!")
  75.   (c:Vimage)
  76.   (princ)
  77. )
  78. (defun c:Vimage ()
  79.   (if (and (findfile (strcat *VimageFolder "Vimage.lsp")) (findfile (strcat *VimageFolder "Vimage.dcl")))
  80.     (progn (load (strcat *VimageFolder "Vimage.lsp")) (Vimage))
  81.     (princ (strcat "\nRun Mimage first to create the " *VimageFolder "Vimage.lsp file."))
  82.   )
  83.   (princ)
  84. )
  85. (defun Align (Number)
  86.   (cond
  87.     ((< Number 10) (strcat "  " (itoa Number)))
  88.     ((< Number 100) (strcat " " (itoa Number)))
  89.     ((itoa Number))
  90.   )
  91. )
  92. (defun ViewPoints (/ Center Height LowerRight UpperLeft Width)
  93.   (setq Height (getvar "viewsize"))
  94.   (setq Width (* Height (/ (car (getvar "screensize")) (cadr (getvar "screensize")))))
  95.   (setq Center (trans (getvar "viewctr") 1 2))
  96.   (setq UpperLeft (trans (list (- (car Center) (/ Width 2.0)) (+ (cadr Center) (/ Height 2.0))) 2 1))
  97.   (setq LowerRight (list (+ (car UpperLeft) Width) (- (cadr UpperLeft) Height)))
  98.   (list UpperLeft LowerRight Width Height)
  99. )
  100. (setq *X nil *Y nil *VimageFolder "C:\\Temp\")
  101. (if (not (findfile (strcat *VimageFolder "Vimage.dcl"))) (vl-mkdir *VimageFolder))
  102. (princ "\nType Mimage2 to make image file or type Vimage to view image.")

评分

参与人数 1明经币 +1 收起 理由
自贡黄明儒 + 1 赞一个!

查看全部评分

回复 支持 反对

使用道具 举报

duotu007
发表于 2011-5-20 17:22:29 | 显示全部楼层
选择对象:
图像范围左下角坐标:
图像范围右上角坐标:
图像像素高为<220>:
图像宽高比率<0.667>:
图像按钮行数<5>:
图像按钮列数<8>:  ; 错误: no function definition: >*>

出错了
回复 支持 反对

使用道具 举报

egos
发表于 2011-5-20 17:49:51 | 显示全部楼层
http://web2.airmail.net/terrycad网站的 GetVectors.lsp这个不错  能同时生成DCL文件和lsp文件
回复 支持 反对

使用道具 举报

zhongys
发表于 2011-5-20 20:19:36 | 显示全部楼层
回复 支持 反对

使用道具 举报

Gu_xl
 楼主| 发表于 2011-5-21 10:13:02 | 显示全部楼层
回复 duotu007 的帖子

已更新，请重新下载！
回复 支持 反对

使用道具 举报

egos
发表于 2011-5-21 10:55:38 | 显示全部楼层
本帖最后由 egos 于 2015-5-8 13:01 编辑

问一下楼主  那些貌似位图的图像按钮是怎么描点实现的？
回复 支持 反对

使用道具 举报

zxmmelly
发表于 2011-5-21 11:21:55 | 显示全部楼层

null

学院派的那个就不错
回复 支持 反对

使用道具 举报

timmy521
发表于 2011-5-21 19:01:44 | 显示全部楼层
好东西啊，要好好学习了啊，
回复 支持 反对

使用道具 举报

timmy521
发表于 2011-5-21 19:12:40 | 显示全部楼层
这个具体怎么用啊，现在还有点不太明白 。
回复 支持 反对

使用道具 举报

12345678910... 24下一页
返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码，在未取得本站及作者授权的情况下，不得用于商业用途

GMT+8, 2024-11-22 20:53 , Processed in 0.193874 second(s), 31 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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