设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › [求助]：修改的对话框程序有点问题，但不知错哪里 ...
返回列表 发新帖
查看: 491|回复: 2

[求助] [求助]：修改的对话框程序有点问题，但不知错哪里

[复制链接]
animal212
发表于 2007-7-30 20:51:54 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

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

×
声明：运行下面的程序会使CAD崩溃。
我想实现的功能是选取图面上的文字，然后在列表框里列出来，然后通过选择列表框里的文字，屏幕会自动缩放到所选择的文字的位置。但没能实现。我改的程序
(DEFUN C:LOOKAT (/)
;;(COMMAND "_.undo" "_begin")
(VL-LOAD-COM)
(SETVAR "dimzin" 0)
(SETQ %resv 2)
(SETQ #showpt '(650 150))
;;;----------------------------------------------------
;;;准备调用DCL
;;;-------------------------------------
;;调入对话框
(WHILE (= %resv 2)
(SETQ dcl_id (LOAD_DIALOG "LOOKAT"))
(IF (< dcl_id 0)
(EXIT)
)
(NEW_DIALOG "LOOKPolyLen" dcl_id "" #showpt)
(IF (AND (= %show 1) (/= #LIST1 nil))
(PROGN
;;开始添加
(START_LIST "list1")
(MAPCAR 'ADD_LIST #LIST1)
(END_LIST)
;;设置显示条数的文本编辑框的值
(SET_TILE "text-num" (ITOA %REP))
)
)
(ACTION_TILE "list1" "(LOOKAT:Hilight $value)")
(ACTION_TILE "bu_select" "(setq %show 1)(DONE_DIALOG 2)")
(ACTION_TILE "accept" "(setq %show 0)(DONE_DIALOG 1)")
(ACTION_TILE "cancel" "(setq %show 0)(DONE_DIALOG 0)")
;;显示并将控制权交对话框
(SETQ %resv (START_DIALOG))
(IF (= %resv 2)
(lookat:select)
)
)
(UNLOAD_DIALOG dcl_id)
;;(COMMAND "_.undo" "_end")


)
;_ 结束DEFUN


(DEFUN lookat:select () ;(/ ss1 e-name1 obj1 %REP %ID !LEN #LIST1)
(SETQ %ID 0)
(SETQ #LIST1 NIL)
;;提示用户选择多段
(SETQ ss1 (SSGET '((0 . "*TEXT"))))
(IF ss1
(PROGN
(SETQ %REP (SSLENGTH SS1))
(REPEAT %REP
(SETQ E-NAME1 (SSNAME SS1 %ID)
ENTI (entget E-NAME1))

(SETQ !LEN (assoc 1 ENTI))
(SETQ !LEN (cdr !LEN))

(SETQ #LIST1 (APPEND #LIST1 (LIST (STRCAT (ITOA (+ %ID 1)) " ..." !LEN))))

(SETQ %ID (+ %ID 1))
)
)
(SETQ %show 1)
)

)

;;;--------------------------------------------------------
;;;函数： lookat:Hilight
;;;--------------------------------------------------------
;;;来源： 　作者: 何俊
;;;编制时间：2006.5.16
;;;功能: 亮显/取消亮显用户在列表框内点击的项目相对应的
;;; 多段线
;;;语法: lookat:Hilight $ID
;;;参数 $ID....用户所点击列表框项目索引值
;;;返回值: 无
;;;备注 : 本函数供c:LOOKAT函数调用.
;;;--------------------------------------------------------

(DEFUN lookat:Hilight ($ID)
(IF e-name2
(REDRAW e-name2 4)
) ;_ 结束if
(SETQ e-name2 (SSNAME ss1 (ATOI $ID))
ENTI2 (entget e-name2))
(SETQ !LEN2 (assoc 10 ENTI2))
(SETQ !LEN2 (cdr !LEN2))
(setq a (getvar "expert" ))
(setvar "expert" 1)
(command "_zoom" "c" !LEN2 "");;;;;;;;;;;;;;;;;;;;;;;;;这是我添加的，可能错误就在这里。
(setvar "expert" a)
(REDRAW e-name2 3)
(PRINC)
) ;_ 结束defun

下面是LOOKAT.DCL文件的代码

dcl_settings : default_dcl_settings { audit_level = 3; }

LOOKPolyLen : dialog {
label = "查找到的文字";
: boxed_column {
label = "文字列表";
: list_box {
key = "list1";
//list = "1234,erqer";
width = 20;
height = 20;
}
: column {
: row {
: edit_box {
label = "共选中对象文字 ";
key = "text-num";
edit_width = 6;
}
: text {
label = "个";
}
}
: edit_box {
label = "总长度";
key = "text-len";
edit_width = 20;
}
}
}
:row {
:retirement_button
{label = "选择..";key = "bu_select";}
ok_cancel;
}
}
SETQ, LOOKAT, LIST

相关帖子

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复

使用道具 举报

carrot1983
发表于 2007-7-31 13:54:41 | 显示全部楼层
问题出在:你的对话框还没有退出就去缩放,CAD就崩溃
[php]
(DEFUN C:LOOKAT        (/)
  ;;(COMMAND "_.undo" "_begin")
  (VL-LOAD-COM)
  (SETVAR "dimzin" 0)
  (SETQ %resv 2)
  (SETQ #showpt '(650 150))
;;;----------------------------------------------------
;;;准备调用DCL
;;;-------------------------------------
  ;;调入对话框
  (WHILE (= %resv 2)
    (SETQ dcl_id (LOAD_DIALOG "LOOKAT"))
    (IF        (< dcl_id 0)
      (EXIT)
    )
    (NEW_DIALOG "LOOKPolyLen" dcl_id "" #showpt)
    (IF        (AND (= %show 1) (/= #LIST1 nil))
      (PROGN
        ;;开始添加
        (START_LIST "list1")
        (MAPCAR 'ADD_LIST #LIST1)
        (END_LIST)
        ;;设置显示条数的文本编辑框的值
        (SET_TILE "text-num" (ITOA %REP))
      )
    )
    (ACTION_TILE "list1" "(LOOKAT:Hilight $value)")
    (ACTION_TILE "bu_select" "(setq %show 1)(DONE_DIALOG 2)")
    (ACTION_TILE "accept" "(setq %show 0)(DONE_DIALOG 1)")
    (ACTION_TILE "cancel" "(setq %show 0)(DONE_DIALOG 0)")
    ;;显示并将控制权交对话框
    (SETQ %resv (START_DIALOG))
    (IF        (= %resv 2)
      (lookat:select)
    )
  )
  (UNLOAD_DIALOG dcl_id)
  ;;把你的缩放移到这里.原因是对话框没退出,就去缩放.CAD就会死掉.
  ;;选中要缩放的字,再按确定.
  (if (= mark 1)
    (progn
      (command "_zoom" "c" !LEN2 "")
      (REDRAW e-name2 3)
    )
  )
  ;;(COMMAND "_.undo" "_end")
)
;_ 结束DEFUN


(DEFUN lookat:select ()                        ;(/ ss1 e-name1 obj1 %REP %ID !LEN #LIST1)
  (SETQ %ID 0)
  (SETQ #LIST1 NIL)
  ;;提示用户选择多段
  (SETQ ss1 (SSGET '((0 . "*TEXT"))))
  (IF ss1
    (PROGN
      (SETQ %REP (SSLENGTH SS1))
      (REPEAT %REP
        (SETQ E-NAME1 (SSNAME SS1 %ID)
              ENTI    (entget E-NAME1)
        )

        (SETQ !LEN (assoc 1 ENTI))
        (SETQ !LEN (cdr !LEN))

        (SETQ
          #LIST1 (APPEND #LIST1
                         (LIST (STRCAT (ITOA (+ %ID 1)) " ..." !LEN))
                 )
        )

        (SETQ %ID (+ %ID 1))
      )
    )
    (SETQ %show 1)
  )

)

;;;--------------------------------------------------------
;;;函数： lookat:Hilight
;;;--------------------------------------------------------
;;;来源： 　作者: 何俊
;;;编制时间：2006.5.16
;;;功能: 亮显/取消亮显用户在列表框内点击的项目相对应的
;;; 多段线
;;;语法: lookat:Hilight $ID
;;;参数 $ID....用户所点击列表框项目索引值
;;;返回值: 无
;;;备注 : 本函数供c:LOOKAT函数调用.
;;;--------------------------------------------------------

(DEFUN lookat:Hilight ($ID)
  (IF e-name2
    (REDRAW e-name2 4)
  ) ;_ 结束if
  (SETQ        e-name2        (SSNAME ss1 (ATOI $ID))
        ENTI2        (entget e-name2)
  )
  (SETQ !LEN2 (assoc 10 ENTI2))
  (SETQ !LEN2 (cdr !LEN2))
  (setq mark 1)
;;;(setq a (getvar "expert" ))
;;;(setvar "expert" 1)
;;;(command "_zoom" "c" !LEN2 "");;;;;;;;;;;;;;;;;;;;;;;;;这是我添加的，可能错误就在这里。
;;;(setvar "expert" a)
;;;(REDRAW e-name2 3)
  (PRINC)
) ;_ 结束defun


[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

carrot1983
发表于 2007-7-31 14:03:30 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
问题出在:你的对话框还没有退出就去缩放,CAD就崩溃
[php]
(DEFUN C:LOOKAT        (/)
  ;;(COMMAND "_.undo" "_begin")
  (VL-LOAD-COM)
  (SETVAR "dimzin" 0)
  (SETQ %resv 2)
  (SETQ #showpt '(650 150))
;;;----------------------------------------------------
;;;准备调用DCL
;;;-------------------------------------
  ;;调入对话框
  (WHILE (= %resv 2)
    (SETQ dcl_id (LOAD_DIALOG "LOOKAT"))
    (IF        (< dcl_id 0)
      (EXIT)
    )
    (NEW_DIALOG "LOOKPolyLen" dcl_id "" #showpt)
    (IF        (AND (= %show 1) (/= #LIST1 nil))
      (PROGN
        ;;开始添加
        (START_LIST "list1")
        (MAPCAR 'ADD_LIST #LIST1)
        (END_LIST)
        ;;设置显示条数的文本编辑框的值
        (SET_TILE "text-num" (ITOA %REP))
      )
    )
    (ACTION_TILE "list1" "(LOOKAT:Hilight $value)")
    (ACTION_TILE "bu_select" "(setq %show 1)(DONE_DIALOG 2)")
    (ACTION_TILE "accept" "(setq %show 0)(DONE_DIALOG 1)")
    (ACTION_TILE "cancel" "(setq %show 0)(DONE_DIALOG 0)")
    ;;显示并将控制权交对话框
    (SETQ %resv (START_DIALOG))
    (IF        (= %resv 2)
      (lookat:select)
    )
  )
  (UNLOAD_DIALOG dcl_id)
  ;;把你的缩放移到这里.原因是对话框没退出,就去缩放.CAD就会死掉.
  ;;选中要缩放的字,再按确定.
  (if (= mark 1)
    (progn
      (command "_zoom" "c" !LEN2 "")
      (REDRAW e-name2 3)
    )
  )
  ;;(COMMAND "_.undo" "_end")
)
;_ 结束DEFUN


(DEFUN lookat:select ()                        ;(/ ss1 e-name1 obj1 %REP %ID !LEN #LIST1)
  (SETQ %ID 0)
  (SETQ #LIST1 NIL)
  ;;提示用户选择多段
  (SETQ ss1 (SSGET '((0 . "*TEXT"))))
  (IF ss1
    (PROGN
      (SETQ %REP (SSLENGTH SS1))
      (REPEAT %REP
        (SETQ E-NAME1 (SSNAME SS1 %ID)
              ENTI    (entget E-NAME1)
        )

        (SETQ !LEN (assoc 1 ENTI))
        (SETQ !LEN (cdr !LEN))

        (SETQ
          #LIST1 (APPEND #LIST1
                         (LIST (STRCAT (ITOA (+ %ID 1)) " ..." !LEN))
                 )
        )

        (SETQ %ID (+ %ID 1))
      )
    )
    (SETQ %show 1)
  )

)

;;;--------------------------------------------------------
;;;函数： lookat:Hilight
;;;--------------------------------------------------------
;;;来源： 　作者: 何俊
;;;编制时间：2006.5.16
;;;功能: 亮显/取消亮显用户在列表框内点击的项目相对应的
;;; 多段线
;;;语法: lookat:Hilight $ID
;;;参数 $ID....用户所点击列表框项目索引值
;;;返回值: 无
;;;备注 : 本函数供c:LOOKAT函数调用.
;;;--------------------------------------------------------

(DEFUN lookat:Hilight ($ID)
  (IF e-name2
    (REDRAW e-name2 4)
  ) ;_ 结束if
  (SETQ        e-name2        (SSNAME ss1 (ATOI $ID))
        ENTI2        (entget e-name2)
  )
  (SETQ !LEN2 (assoc 10 ENTI2))
  (SETQ !LEN2 (cdr !LEN2))
  (setq mark 1)
;;;(setq a (getvar "expert" ))
;;;(setvar "expert" 1)
;;;(command "_zoom" "c" !LEN2 "");;;;;;;;;;;;;;;;;;;;;;;;;这是我添加的，可能错误就在这里。
;;;(setvar "expert" a)
;;;(REDRAW e-name2 3)
  (PRINC)
) ;_ 结束defun


[/php]
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

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

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-17 07:33 , Processed in 0.239465 second(s), 36 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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