明经CAD社区

 找回密码
 注册

扫一扫,访问微社区

QQ登录

只需一步,快速开始

查看: 441|回复: 5

[提问] LISP工具面板上如何做画面

[复制链接]
发表于 2018-1-10 02:57 | 显示全部楼层 |阅读模式
本帖最后由 whg587081 于 2018-1-10 03:09 编辑

如图所示,lisp做的面板上如何显示的龙

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?注册

x
发表于 2018-1-10 08:33 | 显示全部楼层
还能这样啊
发表于 2018-1-11 01:47 | 显示全部楼层






麻烦楼主拿程序时先去原面板作者帖子看看!
以下为描点程序代码



讨论可以加入明经群,以下是描点程序:[code="lisp] (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)
  (princ "\nMimage makes an image file for a dialog image tile.") (setvar "cmdecho" 0) (redraw)
  (setq UpperLeft (nth 0 (ViewPoints)) LowerRight (nth 1 (ViewPoints)) Width (nth 2 (ViewPoints)) Height (nth 3 (ViewPoints)))
  (if (not *X) (setq *X (fix (+ 0.5 (* 100 (/ Width (float Height)))))))
  (if (not *Y) (setq *Y 100))
  (if (not (setq X (getint (strcat "\nEnter dimx_tile value <" (itoa *X) ">: ")))) (setq X *X))
  (if (not (setq Y (getint (strcat "\nEnter dimy_tile value <" (itoa *Y) ">: ")))) (setq Y *Y))
  (if (or (< X 2) (< Y 2))
    (progn (princ "\nThe dimx_tile and dimy_tile values must be greater than 1.") (exit))
    (setq *X X *Y Y)
  )
  (if (< (/ X (float Y)) (/ Width Height))
    (setq Dist (* Height (/ X (float Y))) Pt (list (+ (car UpperLeft) Dist) (cadr LowerRight)))
    (setq Dist (* Width (/ Y (float X))) Pt (list (car LowerRight) (- (cadr UpperLeft) Dist)))
  )
  (grdraw UpperLeft (list (car UpperLeft) (cadr Pt)) 1) (grdraw (list (car UpperLeft) (cadr Pt)) Pt 1)
  (grdraw Pt (list (car Pt) (cadr UpperLeft)) 1) (grdraw (list (car Pt) (cadr UpperLeft)) UpperLeft 1)
  (initget "Yes No") (setq Inside (getkword "\nAre the image objects inside the red outline? [Yes/No] <Y>: "))
  (if (= Inside "No") (progn (princ "\nPan or zoom as required, then run the program again.") (exit)))
  (initget "Yes No") (setq BackGround (getkword "\nDo you want an image background? [Yes/No] <Y>: "))
  (setq BackGround (if (= BackGround "No") "    color = -15;" "    color = -2;"))
  (princ "\nCreating image file...") (princ)
  (if (setq Objects (ssget "c" UpperLeft Pt))
    (progn
      (setq WmfFile (vl-filename-mktemp "Temp.wmf") XY (list X (* Y -1)))
      (command "wmfout" WmfFile Objects "" "undo" "begin" "zoom" "0,0" XY)
      (setq LastEntity (entlast) SaveOsmode (getvar "osmode")) (setvar "osmode" 0)
      (command "wmfin" WmfFile "0,0" 2 2 0) (setvar "osmode" SaveOsmode)
      (setq Entity (entlast)) (command "explode" Entity)
      (while (setq Entity (entnext Entity))
        (if (= (cdr (assoc 0 (entget Entity))) "POLYLINE") (command "explode" Entity))
      )
      (setq Entity LastEntity)
      (while (setq Entity (entnext Entity))
        (setq DxfData (entget Entity))
        (if (= (cdr (assoc 0 DxfData)) "LINE")
          (progn
            (setq X1s (append X1s (list (fix (cadr (assoc 10 DxfData))))))
            (setq Y1s (append Y1s (list (fix (abs (caddr (assoc 10 DxfData)))))))
            (setq X2s (append X2s (list (fix (cadr (assoc 11 DxfData))))))
            (setq Y2s (append Y2s (list (fix (abs (caddr (assoc 11 DxfData)))))))
            (setq Colors (append Colors (list (cdr (assoc 62 DxfData)))))
          )
        )
      )
      (command "undo" "end" "undo" 1)
    )
  )
  (setq WidthX (rtos (+ (* (1- X) (/ 1 6.0)) 0.09) 2 2) HeightY (rtos (+ (* (1- Y) (/ 1 13.0)) 0.048) 2 2))
  (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;" "}"))
  (setq DclFile (open (strcat *VimageFolder "Vimage.dcl") "w"))
  (foreach Line DclList (write-line Line DclFile)) (close DclFile)
  (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")"))
  (if Objects
    (progn
      (setq LspList (append LspList (list "  (mapcar 'vector_image")))
      (setq Line "    (list") (foreach Number X1s (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
      (setq LspList (append LspList (list Line)))
      (setq Line "    (list") (foreach Number Y1s (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
      (setq LspList (append LspList (list Line)))
      (setq Line "    (list") (foreach Number X2s (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
      (setq LspList (append LspList (list Line)))
      (setq Line "    (list") (foreach Number Y2s (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
      (setq LspList (append LspList (list Line)))
      (setq Line "    (list") (foreach Number Colors (setq Line (strcat Line " " (Align Number)))) (setq Line (strcat Line ")"))
      (setq LspList (append LspList (list Line "  )")))
    )
  )
  (setq LspList (append LspList (list "  (end_image)" ")")))
  (setq LspFile (open (strcat *VimageFolder "Vimage.lsp") "w"))
  (foreach Line LspList (write-line Line LspFile)) (close LspFile)
  (princ " Complete!")
  (c:Vimage)
  (princ)
)
(defun c:Vimage ()
  (if (and (findfile (strcat *VimageFolder "Vimage.lsp")) (findfile (strcat *VimageFolder "Vimage.dcl")))
    (progn (load (strcat *VimageFolder "Vimage.lsp")) (Vimage))
    (princ (strcat "\nRun Mimage first to create the " *VimageFolder "Vimage.lsp file."))
  )
  (princ)
)
(defun Align (Number)
  (cond
    ((< Number 10) (strcat "  " (itoa Number)))
    ((< Number 100) (strcat " " (itoa Number)))
    ((itoa Number))
  )
)
(defun ViewPoints (/ Center Height LowerRight UpperLeft Width)
  (setq Height (getvar "viewsize"))
  (setq Width (* Height (/ (car (getvar "screensize")) (cadr (getvar "screensize")))))
  (setq Center (trans (getvar "viewctr") 1 2))
  (setq UpperLeft (trans (list (- (car Center) (/ Width 2.0)) (+ (cadr Center) (/ Height 2.0))) 2 1))
  (setq LowerRight (list (+ (car UpperLeft) Width) (- (cadr UpperLeft) Height)))
  (list UpperLeft LowerRight Width Height)
)
(setq *X nil *Y nil *VimageFolder "C:\\Temp\")
(if (not (findfile (strcat *VimageFolder "Vimage.dcl"))) (vl-mkdir *VimageFolder))
(princ "\nType Mimage2 to make image file or type Vimage to view image.")
[/code]描完后的文件保存在c:\temp,也可以自己修改路径。
发表于 2018-1-11 01:51 | 显示全部楼层
自己做的DCL工具面板(源码)   免币分享
http://bbs.mjtd.com/forum.php?mo ... amp;fromuid=7318880
(出处: 明经CAD社区)
 楼主| 发表于 2018-1-11 06:08 | 显示全部楼层
东升铮 发表于 2018-1-11 01:47
麻烦楼主拿程序时先去原面板作者帖子看看!
以下为描点程序代码

谢谢 ,我试一下
 楼主| 发表于 2018-1-11 06:12 | 显示全部楼层
东升铮 发表于 2018-1-11 01:47
麻烦楼主拿程序时先去原面板作者帖子看看!
以下为描点程序代码

Creating image file...; 错误: *error* 函数中出错no function definition: =S
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2018-4-20 05:24 , Processed in 0.185362 second(s), 28 queries , Gzip On.

Powered by Discuz! X3.3

© 2001-2013 Comsenz Inc.

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