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

明经CAD社区

 找回密码
 注册

QQ登录

只需一步，快速开始

搜索
明经CAD社区»社区 › 开发篇 › AutoLISP/Visual LISP 编程技术 › 自己做的DCL工具面板(源码) 免币分享
12345678910下一页
返回列表 发新帖
楼主: 恕放之生命

[源码] 自己做的DCL工具面板(源码) 免币分享

    [复制链接]
myfrankie
发表于 2014-10-28 08:57 | 显示全部楼层
请问如何加入其它的脚本，如lsp vlx arx 等
回复 支持 反对

使用道具 举报

恕放之生命
 楼主| 发表于 2014-10-28 09:19 | 显示全部楼层
myfrankie 发表于 2014-10-28 08:57
请问如何加入其它的脚本，如lsp vlx arx 等

这是很基础的修改阿，请看下面图片说明。



根据实际需要修改对话框后，上面的内容相应修改一下就行了，如果还不懂就先学一下基础教程吧。

本帖子中包含更多资源

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

x
回复 支持 反对

使用道具 举报

lpl
发表于 2014-10-28 12:28 | 显示全部楼层
恕放之生命 发表于 2014-10-28 09:19
这是很基础的修改阿，请看下面图片说明。

位图的像素您是怎么提取出来的代码
(list  26 147 147  26  26  28 145 145  28  28 145  86 101 101 101 123 113  86  86  86 115 101)
    (list  15  15  86  86  15  17  17  84  84  17  63  63  17  25  21  25  25  74  69  79  63  63)
    (list 147 147  26  26  26 145 145  28  28  28  86  86 101 145 145 123 113 145 145 145 115 101)
    (list  15  86  86  15  15  17  84  84  17  17  63  84  25  25  21  17  17  74  69  79  84  84)
    (list   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7   7)
回复 支持 反对

使用道具 举报

恕放之生命
 楼主| 发表于 2014-10-28 13:40 | 显示全部楼层
lpl 发表于 2014-10-28 12:28
位图的像素您是怎么提取出来的代码
(list  26 147 147  26  26  28 145 145  28  28 145  86 101 101 10 ...

描点阿，在论坛上找。

点评

lpl
能否留个QQ号交流下，有问题咨询，谢谢  发表于 2014-10-28 17:47
回复 支持 反对

使用道具 举报

lpl
发表于 2014-10-28 14:03 来自手机 | 显示全部楼层
恕放之生命 发表于 2014-10-28 13:40
描点阿，在论坛上找。

我用高飞鸟的提取像素，不知道怎么搞
回复 支持 反对

使用道具 举报

love1030312
发表于 2014-10-29 09:36 | 显示全部楼层
支持啊  
回复 支持 反对

使用道具 举报

lyqiezi
发表于 2014-10-29 12:56 | 显示全部楼层
love1030312 发表于 2014-10-29 09:36
支持啊

感谢分享，收藏备用（还没弄过对话框）
回复 支持 反对

使用道具 举报

恕放之生命
 楼主| 发表于 2014-10-29 13:39 | 显示全部楼层
lpl 发表于 2014-10-28 14:03
我用高飞鸟的提取像素，不知道怎么搞

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

使用道具 举报

lpl
发表于 2014-10-29 13:58 | 显示全部楼层
恕放之生命 发表于 2014-10-29 13:39
讨论可以加入明经群，以下是描点程序：描完后的文件保存在c:\temp,也可以自己修改路径。

这个描点程序，没有高飞鸟的像素专家好，可以提取图片的像素
回复 支持 反对

使用道具 举报

zh74
发表于 2014-10-29 22:20 | 显示全部楼层
学习一下，感谢分享
回复 支持 反对

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-6-29 09:57 , Processed in 0.191910 second(s), 20 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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