乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 ☆ ☆ ☆ 尊重版权，从我做起，拒绝盗版，拒绝倒卖 ☆ ☆ ☆ 签到、发布资源、邀请好友注册，可以获得银币 ☆ ☆ ☆ 请注意保管好自己的密码，避免账户资金被盗
查看： 18|回复： 18

[编程交流] DCL检索val的帮助

[复制链接]
BIGAL

106

主题

1万

帖子

101

银币

顶梁支柱

Rank: 50Rank: 50

铜币
1299
发表于 2022-7-5 13:21:20 | 显示全部楼层 |阅读模式
我决定编写我自己版本的多行输入dcl以满足我们的需要，其思想是dcl的大小基于列表中的项目数，因此这部分效果很好，我最终得到了一个具有默认值的多行dcl。我有它的工作，有一些有趣的事情发生了，所以改变了代码，现在我已经失去了整个工作的东西。
 
重复设置平铺默认值，但平铺不返回该值
 
任何帮助都将不胜感激。
 
  2. ; Input  Dialog box with variable title
  3. ; multiple lines of dcl input supported
  4. ; add extra values to the list
  5. (vl-load-com)
  7. ; returns the value of key1 key2 and key3 etc  as strings
  9. ; sample code (ah:getval2018 "heading at top" (list "Line 1" 5 4 "1" "Line2" 8 7 "2"))
  10. ; (setq dcllst (list "Line 1" 5 4 "1" "Line2" 8 7 "22" "Line3" 8 7 "3" "Line4" 8 7 "44"))
  11. ; (AH:getval2018 "This is heading" (list "Line 1" 5 4 "1" "Line2" 8 7 "22" "Line3" 8 7 "3" "Line4" 8 7 "44"))
  12. (defun  AH:getval2018 (heading dcllst /  x y ans fo fname keynum)
  13. (setq num (/ (length dcllst) 4))
  14. (setq x 0)
  15. (setq  y 0)
  16. (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
  17. (write-line "ddgetvalAH : dialog {" fo)
  18. (write-line  (strcat "        label =" (chr 34) heading (chr 34) " ;" )fo)
  19. (write-line " : column {" fo)
  20. (repeat num
  21. (write-line "spacer_1 ;" fo)
  22. (write-line ": edit_box {" fo)
  23. (setq keynum (strcat "key" (rtos (setq y (+ Y 1)) 2 0)))
  24. (write-line (strcat "    key = " (chr 34) keynum (chr 34) ";") fo)
  25. (write-line  (strcat " label = "  (chr 34) (nth x dcllst) (chr 34) ";" ) fo)
  26. (write-line (strcat "     edit_width = " (rtos (nth (+ x 1) dcllst) 2 0) ";" ) fo)
  27. (write-line (strcat "     edit_limit = " (rtos (nth (+ x 2) dcllst) 2 0) ";" ) fo)
  28. (write-line "   is_enabled = true ;" fo)
  29. (write-line "    }" fo)
  30. (setq x (+ x 4))
  31. )
  32. (write-line "    }" fo)
  33. (write-line "spacer_1 ;" fo)
  34. (write-line "ok_only;}" fo)
  35. (close fo)
  36. (setq dcl_id (load_dialog  fname))
  37. (if (not (new_dialog "ddgetvalAH" dcl_id))
  38. (exit))
  39. (setq x -1)
  40. (setq y 0)
  41. (repeat  num
  42. (setq keynum  (strcat "key" (rtos (setq y (+ Y 1)) 2 0)))
  43. (setq valnum (strcat "val" (rtos y 2 0)))
  44. (set_tile keynum (nth (setq x (+ x 4)) dcllst))
  45. ;;;; problem is here
  46. (action_tile keynum (strcat "(set " "(read valnum)" " $value)"))
  47. (mode_tile  keynum  3)
  48.  )
  49. (start_dialog)
  50. (unload_dialog dcl_id)
  51. )
  52. (AH:getval2018 "This is heading" (list "Line 1" 5 4 "1" "Line2" 8 7 "22" "Line3" 8 7 "3" "Line4" 8 7 "44"))
回复

使用道具 举报

marko_ribar

5

主题

1334

帖子

1410

银币

限制会员

铜币
-20
发表于 2022-7-5 13:25:30 | 显示全部楼层
也许是这样，不太确定——它回来了！val1！val2！val3。。。
 
  2. ; sample code (ah:getval2018 "heading at top" (list "Line 1" 5 4 "1" "Line2" 8 7 "2"))
  3. ; (setq dcllst (list "Line 1" 5 4 "1" "Line2" 8 7 "22" "Line3" 8 7 "3" "Line4" 8 7 "44"))
  4. ; (AH:getval2018 "This is heading" (list "Line 1" 5 4 "1" "Line2" 8 7 "22" "Line3" 8 7 "3" "Line4" 8 7 "44"))
  5. (defun AH:getval2018 ( heading dcllst / x y fo fname keynum valnum keylst vallst )
  6.   (setq num (/ (length dcllst) 4))
  7.   (setq x 0)
  8.   (setq y 0)
  9.   (setq fo (open (setq fname (vl-filename-mktemp "" "" ".dcl")) "w"))
  10.   (write-line "ddgetvalAH : dialog {" fo)
  11.   (write-line (strcat "        label =" (chr 34) heading (chr 34) " ;" ) fo)
  12.   (write-line " : column {" fo)
  13.   (repeat num
  14.     (write-line "spacer_1 ;" fo)
  15.     (write-line ": edit_box {" fo)
  16.     (setq keynum (strcat "key" (rtos (setq y (1+ y)) 2 0)))
  17.     (write-line (strcat "    key = " (chr 34) keynum (chr 34) ";") fo)
  18.     (write-line (strcat "  label = " (chr 34) (nth x dcllst) (chr 34) ";") fo)
  19.     (write-line (strcat "     edit_width = " (rtos (nth (+ x 1) dcllst) 2 0) ";") fo)
  20.     (write-line (strcat "     edit_limit = " (rtos (nth (+ x 2) dcllst) 2 0) ";") fo)
  21.     (write-line "   is_enabled = true ;" fo)
  22.     (write-line "    }" fo)
  23.     (setq x (+ x 4))
  24.   )
  25.   (write-line "    }" fo)
  26.   (write-line "spacer_1 ;" fo)
  27.   (write-line "ok_only;}" fo)
  28.   (close fo)
  29.   (setq dcl_id (load_dialog fname))
  30.   (if (not (new_dialog "ddgetvalAH" dcl_id))
  31.     (exit)
  32.   )
  33.   (setq x -1)
  34.   (setq y 0)
  35.   (repeat num
  36.     (setq keynum (strcat "key" (rtos (setq y (1+ y)) 2 0)))
  37.     (setq valnum (strcat "val" (rtos y 2 0)))
  38.     (setq keylst (cons keynum keylst))
  39.     (setq vallst (cons valnum vallst))
  40.   )
  41.   (foreach a (reverse vallst)
  42.     (set (read a) (nth (setq x (+ x 4)) dcllst))
  43.   )
  44.   (setq x -1)
  45.   (foreach ab (mapcar '(lambda ( a b ) (list a b)) (reverse keylst) (reverse vallst))
  46.     (set_tile (car ab) (nth (setq x (+ x 4)) dcllst))
  47.     (action_tile (car ab) (strcat "(setq " (cadr ab) " $value)"))
  48.     (mode_tile (car ab) 3)
  49.   )
  50.   (start_dialog)
  51.   (unload_dialog dcl_id)
  52.   (vl-file-delete fname)
  53. )
HTH。，M、 R。
回复

使用道具 举报

dlanorh

0

主题

946

帖子

978

银币

限制会员

铜币
-3
发表于 2022-7-5 13:30:35 | 显示全部楼层
问题是（read valnum）。您将其设置在循环内，但当valnum=val4时，动作互动程序动作发生在循环外，因此每个动作互动程序都将设置val4。
回复

使用道具 举报

marko_ribar

5

主题

1334

帖子

1410

银币

限制会员

铜币
-20
发表于 2022-7-5 13:33:12 | 显示全部楼层
 
动作块在循环内，问题实际上是（设置）函数。。。在我的示例中，我使用了（setq）并通过直接（strcat）-输入字符串值来避免（读取）。。。
回复

使用道具 举报

dlanorh

0

主题

946

帖子

978

银币

限制会员

铜币
-3
发表于 2022-7-5 13:36:40 | 显示全部楼层
 
对不起，在我发布之前没有看到你的帖子。是的，在BigAls代码中，设置动作平铺在循环内，但循环结束。此时，valnum=val4。然后，对话框启动，动作块事件在循环外发生（为每个动作块事件设置（读取值）$值）；循环外的valnum=val4。因此，每个动作块事件都会设置val4。
 
顺便说一句，解决方法不错。
回复

使用道具 举报

rlx

21

主题

1505

帖子

1551

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
81
发表于 2022-7-5 13:38:23 | 显示全部楼层
只有4种乐趣：
 
  2. ;
  3. ; for BigAl - rlx 4 sep 2018
  6. (defun Eddie ( $txt1 %lst / err fn fp dcl nof-eddies Eddie-list slider-index org-list)
  7.   (Eddie_Init)
  8.   (Eddie_Dialog)
  9.   (Eddie_Exit)
  10.   (terpri)
  11.   %lst
  12. )
  14. (defun Eddie_Init ()
  15.   (setq err *error* *error* Eddie_err org-list %lst)
  16.   (cond
  17.     ((not (setq fn (vl-filename-mktemp "Eddie.dcl"))))
  18.     ((not (setq fp (open  fn "w"))))
  19.     ((null %lst))
  20.     (t (setq nof-eddies (length %lst)))
  21.   )
  22.    
  23.   (if (null %lst)
  24.     (progn (alert "Nothing to show")(Eddie_Exit))
  25.     (progn
  26.       (Eddie_write_header)
  27.       (if (<= nof-eddies 10)(Eddie_write_body1 %lst)(Eddie_write_body2 %lst))
  28.       (Eddie_write_footer)
  29.     )
  30.   )
  31.   (if fp (close fp))(gc)
  32.   (setq slider-index 0)
  33. )
  35. (defun Eddie_err (s) (princ s)(Eddie_Exit)(princ))
  36. (defun Eddie_Exit ()
  37.   (setq *error* err)
  38.   (if fp (close fp))
  39.   (if dcl (unload_dialog dcl))
  40.   (if (and fn (findfile fn))(vl-file-delete fn))
  41. )
  44. (defun Eddie_write_header ()
  45.   (write-line
  46.     (strcat
  47.       "Eddie:dialog{label="Eddie - BigAl (2018)";spacer;spacer;"
  48.       ":text_part {key="txt1";width=32;fixed_width=true;}"
  49.       ) fp))
  52. (defun Eddie_write_body1 ( %lst / i )
  53.   (write-line ":boxed_row {" fp)
  54.   (write-line ":column {" fp)
  55.   (setq i 0)
  56.   (mapcar
  57.     '(lambda (x)
  58.        (write-line
  59.          (strcat ":text_part{key="tp" (itoa i) "";label="" (car x) "";width=32;fixed_width=true;}")
  60.          fp
  61.        )
  62.        (setq i (1+ i))
  63.      )
  64.     %lst
  65.   );|close column|;(write-line "spacer;}" fp)
  66.  
  67.   (write-line ":column {" fp)
  68.   (setq i 0)
  69.   (mapcar
  70.     '(lambda (x)
  71.        (write-line
  72.          (strcat ":edit_box{key="eb" (itoa i) "";width=12;fixed_width=true;}")
  73.          fp
  74.        )
  75.        (setq i (1+ i))
  76.      )
  77.     %lst
  78.   );|close column & row|;(write-line "spacer;}}" fp)
  79. )
  81. (defun Eddie_write_body2 ( %lst / i )
  82.   (write-line ":boxed_row {" fp)
  83.   (write-line ":column {" fp)
  84.   (setq i 0)
  85.   (repeat 10
  86.     (write-line
  87.       (strcat ":text_part {key="tp" (itoa i) "";label="" (car (nth i %lst)) "";width=32;fixed_width=true;}")
  88.       fp
  89.     )
  90.     (setq i (1+ i))
  91.   ) ;|close column|; (write-line "spacer;}" fp)
  93.   (write-line ":column {" fp)
  94.   (setq i 0)
  95.   (repeat 10
  96.     (write-line
  97.       (strcat ":edit_box {key="eb" (itoa i) "";width=12;fixed_width=true;}")
  98.       fp
  99.     )
  100.     (setq i (1+ i))
  101.   );|close column|; (write-line "spacer;}" fp)
  102.  
  103.   (write-line
  104.     (strcat ":column {:slider {key="sldr";layout=vertical;min_value="
  105.             (itoa (- 0 nof-eddies)) ";max_value=0;small_increment=1;big_increment=10;value=0;}}}"
  106.     )
  107.     fp
  108.   )
  109. )
  111. (defun Eddie_write_footer ()
  112.   (write-line "spacer;spacer;ok_cancel;}" fp))
  114. (defun Eddie_Dialog ( / n drv inp)
  115.   (if (and (setq n 0 dcl (load_dialog fn)) (new_dialog "Eddie" dcl))
  116.     (progn
  117.       (Eddie_DialogUpdate)
  118.       (Eddie_DialogActions)
  119.       (setq drv (start_dialog))
  120.       (if (= drv 1)
  121.  (mapcar '(lambda (x y) (if (= x "1")(setq return (cons y return)))) Eddie-list %lst)
  122.  (setq return nil))
  123.     )
  124.   )
  125. )
  127. (defun Eddie_DialogUpdate ( / i )
  128.   (if (= (type $txt1) 'STR)(set_tile "txt1" $txt1))
  129.   (set_tile "sldr" (itoa slider-index))
  130.   (update_Eddies)
  131. )
  133. (defun Eddie_DialogActions ()
  134.   (repeat 10 (action_tile (strcat "eb" (itoa n)) (strcat "(edit_me $value " (itoa n) ")" ))(setq n (1+ n)))
  135.   (action_tile "sldr" "(update_slider $value)")
  136.   (action_tile "ok" "(done_dialog 1)")
  137.   (action_tile "cancel" "(setq %lst org-list)(done_dialog 0)")
  138. )
  140. (defun update_slider ( #i )
  141.   (setq slider-index (atoi #i))
  142.   (Eddie_DialogUpdate)
  143. )
  145. (defun update_Eddies (/ Eddie-index Eddie-name i)
  146.   ;max number of Eddies in dialog is 10
  147.   (if (> (abs slider-index) (- nof-eddies 10))
  148.     (setq Eddie-index (- nof-eddies 10))(setq Eddie-index (abs slider-index)))
  149.   (if (< Eddie-index 0)(setq Eddie-index 0))
  150.   (setq i 0)
  151.   (while (and (< i 10) (setq Eddie-name (car (nth Eddie-index %lst))))
  152.     (set_tile (strcat "tp" (itoa i)) Eddie-name)
  153.     (set_tile (strcat "eb" (itoa i)) (vl-princ-to-string (cadr (nth Eddie-index %lst))))
  154.     (setq i (1+ i) Eddie-index (1+ Eddie-index))
  155.   )
  156. )
  158. (defun edit_me ( $v #i / idx )
  159.   (if (> (abs slider-index) (- nof-eddies 10))
  160.     (setq idx (- nof-eddies 10))  (setq idx (abs slider-index)))
  161.   (setq idx (+ #i (if (< idx 0) 0 idx))
  162.         %lst (subst (list (car (nth idx %lst)) $v) (nth idx %lst) %lst)))
  164. ;print list (test function)
  165. (defun prl (lst)(mapcar '(lambda(x)(princ "\n")(princ x)) lst))
  168. (defun c:t1 ()
  169.   (prl
  170.     (Eddie "This is heading" '(("Line 1" 1) ("Line 2" 22) ("Line 3" 33)("Line 4" 44)))
  171.   )
  172.   (princ)
  173. )
  175. (defun c:t2 ()
  176.   (prl
  177.     (Eddie "This is heading"
  178.          '( ("Line  1"  11) ("Line  2"  22) ("Line  3"  33) ("Line  4"  44) ("Line  5"  55)
  179.             ("Line  6"  66) ("Line  7"  77) ("Line  8"  88) ("Line  9"  99) ("Line 10" 100)
  180.             ("Line 11" 110) ("Line 12" 120) ("Line 13" 130) ("Line 14" 140) ("Line 15" 150)
  181.           )
  182.     )
  183.   )
  184.   (princ)
  185. )
回复

使用道具 举报

dlanorh

0

主题

946

帖子

978

银币

限制会员

铜币
-3
发表于 2022-7-5 13:43:40 | 显示全部楼层
我的2美分：
 
改变
 
  2. (action_tile keynum (strcat "(set " "(read valnum)" " $value)"))

 
  2. (action_tile keynum (strcat "(setq val" (itoa y) " $value)"))

并删除
 
  2. (setq valnum (strcat "val" (rtos y 2 0)))
回复

使用道具 举报

marko_ribar

5

主题

1334

帖子

1410

银币

限制会员

铜币
-20
发表于 2022-7-5 13:46:22 | 显示全部楼层
@德拉诺
你是对的，但我认为这不是唯一的问题。。。在循环并完成动作磁贴后，未更改的值似乎不会被签名到val变量。。。所以我必须按照我修改的方式来做。。。不确定，但只需在对话框中按“确定”即可检查是否需要，并且不要更改任何内容。。。如果val（s）不是nil（s），那么您的修复是可以的，但如果我是对的，那么我认为它必须被编码得更大。。。我仍然不太明白为什么（set）不能工作-必须（setq）-ing。。。
回复

使用道具 举报

dlanorh

0

主题

946

帖子

978

银币

限制会员

铜币
-3
发表于 2022-7-5 13:50:00 | 显示全部楼层
@马尔科·里巴
我在BigAl中添加了一些代码来处理被选择的OK，并将值收集到一个列表中以传递回调用程序。这将返回预期值。我的改编代码：
 
有趣的是（set（read numval）1）在命令行上工作，但尝试时出错（strcat“set”（read numval）“$value”）
 
通过将（read numval）更改为“（read numval）”解决了该错误。然而，这是一个字符串，因此在生成字符串“set（read numval）$value”的strcat中永远不会计算（read numval）。该字符串被设置为所有4个编辑框的操作命令，仅在触发action\u tile事件时才对其进行计算，该事件位于循环之外。希望这有意义。
回复

使用道具 举报

rlx

21

主题

1505

帖子

1551

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
81
发表于 2022-7-5 13:52:27 | 显示全部楼层 
  3. (defun tst1 ( / $value val1)
  4.   ; (action_tile "key1" (strcat "(setq " "val1" " $value)"))
  5.   ; -> (action_tile "key1" "(setq val1 $value)")
  6.   (setq $value "1")
  7.   (eval "(setq val1 $value)")
  8.   (eval (read "(setq val1 $value)"))
  9.   (princ)
  10. )
  12. (defun tst2 ( / $value val1)
  13.   ; (action_tile "key1" (strcat "(set " "val1" " $value)"))
  14.   ; -> (action_tile "key1" "(set val1 $value)")
  15.   (setq $value "1")
  16.   (eval "(set val1 $value)")
  17.   ; (eval (read "(set val1 $value)")) ; error: bad argument type: symbolp "1"
  18.   (eval (read "(set (quote val1) $value)"))
  19.   (princ)
  20. )
回复

使用道具 举报

12下一页
返回列表 发帖

发表回复

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

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-3-15 00:49 , Processed in 1.559552 second(s), 72 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表