DCL中的复选框

Grrr · 发表于 2022-7-5 16:57:37

我无法抗拒：


(defun C:test ( / *error* dcl des dch dcf L r mann perc ChosenDiameters )
 
 (defun *error* ( msg )
   (and (< 0 dch) (unload_dialog dch))
   (and (eq 'FILE (type des)) (close des))
   (and (eq 'STR (type dcl)) (findfile dcl) (vl-file-delete dcl))
   (and msg (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\nError: " msg)) ))
   (princ)
 ); defun *error*
 
 (if 
   (and ; write the dialog on the fly - temporary use 
     (setq dcl (vl-filename-mktemp nil nil ".dcl")) 
     (setq des (open dcl "w"))
     (princ
       (strcat
         "samp8 : dialog"
         "{ label = "Pipe Lines";"
         "  : row"
         "  { : boxed_column"
         "    { label = "Pipe diameters used (mm)"; spacer;"
         "      : list_box { key = "LB"; multiple_select = true; width = 10; height = 15; }"
         "    }"
         "    : boxed_column "
         "    { label = "Variables";"
         "      : edit_box { key = "eb1"; label = "Manning 'n'"; edit_width = 6 ; value = "0.013"; }"
         "      : edit_box { key = "eb2"; label = "% part full"; edit_width = 6 ; value = "50"; }"
         "    }"
         "  }"
         "  ok_cancel;"
         "}"
       ); strcat
       des
     ); princ
     (not (setq des (close des)))
     (setq dch (load_dialog dcl))
     (new_dialog "samp8" dch)
   ); and
   (progn
     ; Populate the list_box tile:
     (start_list "LB") 
     (mapcar 'add_list (setq L '("150" "200" "225" "250" "300" "375" "450" "600")))
     (end_list)
     ; Set the first item as default value in the list box:
     (set_tile "LB" "0") 
     ; Set default values - if ok is pressed without any input:
     (setq r (get_tile "LB"))
     (setq mann (get_tile "eb1"))
     (setq perc (get_tile "eb2"))
     ; Set default actions for the tiles:
     (action_tile "LB" "(setq r $value)")
     (action_tile "eb1" "(setq mann $value)")
     (action_tile "eb2" "(setq perc $value)")
     (action_tile "accept" "(done_dialog 1)")
     ; Store the result - if user pressed OK, dcf will be 1, else 0
     (setq dcf (start_dialog))
   ); progn
 ); if
 (*error* nil) ; unload, and erase the temporary dcl file
 
 ; Check if user pressed OK
 (if (= 1 dcf) 
   (alert ; Display the results:
     (strcat
       "\nList of selected diameters: \n"
       (vl-prin1-to-string (setq ChosenDiameters (mapcar '(lambda (x) (nth x L)) (read (strcat "(" r ")")))))
       "\nManning: " mann
       "\nPercentage: " perc
     ); strcat
   ); alert
 ); if 
 (princ)
); defun

当然要归功于李·麦克（但基本上我写的每一个DCL代码，他都隐藏在那个里——就我所知）。

BIGAL · 发表于 2022-7-5 17:01:43

了解你想要能够从列表中选择多个大小签出李mac listbox lsp允许多选择我也会签出它。

BIGAL · 发表于 2022-7-5 17:03:42

copy


; credit to lee-mac for original dcl list routine
(defun C:samp8 ( )
(setq lst (list "150" "200" "225" "250" "300" "375" "450" "600"))
(setq rtn '())
(setq dcl_id (load_dialog "c:\\acadtemp\\samp8.dcl")) ; change directory path to known location
(if (not (new_dialog "samp8" dcl_id))
(exit)
)
(set_tile "eb1" "0.013")
(set_tile "eb2" "50")
(start_list "list")
(foreach itm lst (add_list itm))
(end_list)
(setq ans (set_tile "list" "0"))
(action_tile "list" "(setq rtn (cons (atof (nth (atoi $value) lst)) rtn))")
(action_tile "eb1" "(setq mann (atof $value))")
(action_tile "eb2" "(setq perc (atof $value))")
(start_dialog)
(unload_dialog dcl_id)
(alert "use !rtn !perc !mann to see answers") ; rub this line out later
)

Roy_043 · 发表于 2022-7-5 17:07:59

多选列表框的$value字符串可以包含多个整数（例如“5 1 3”）。你可以用这样的方法来处理它：

copy

(action_tile "list" "(setq rtn (mapcar '(lambda (idx) (nth idx lst)) (read (strcat "(" $value ")"))))")

aloy · 发表于 2022-7-5 17:11:52

谢谢BIGAL、Grrr和Roy，
我试图找到一个解决方案的目的是自动为特定流量选择最合适的直径和斜率，以及其他适用的条件，如值n和“满载百分比”。我能够在我的第1条帖子中成功地使用dcl，并在他的第4条帖子中很好地捕获Grrr给出的选择的方法，如下所示：

copy

(defun C:samp11 ()
 (setq dcl_id(load_dialog "samp11.dcl"))
 (if(not(new_dialog "samp11" dcl_id)
    )
   (exit)
 )
 
(action_tile "tog1"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t1 nil))
      ( (= "1" $value) (setq t1 150)))))
(action_tile "tog2"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t2 nil))
      ( (= "1" $value) (setq t2 200)))))
(action_tile "tog3"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t3 nil))
      ( (= "1" $value) (setq t3 225)))))
(action_tile "tog4"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t4 nil))
      ( (= "1" $value) (setq t4 250)))))
(action_tile "tog5"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t5 nil))
      ( (= "1" $value) (setq t5 300)))))
(action_tile "tog6"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t6 nil))
      ( (= "1" $value) (setq t6 375)))))
(action_tile "tog7"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t7 nil))
      ( (= "1" $value) (setq t7 450)))))
(action_tile "tog8"
 (vl-prin1-to-string
   '(cond
      ( (= "0" $value) (setq t8 nil))
      ( (= "1" $value) (setq t8 600)))))
(start_dialog)
 (unload_dialog dcl_id)
 )
 
(defun pdandslope()
 (setq lst nil)
 (setq p150 '((150.0 120.0) (150.0 110.0) (150.0 100.0)))
 (setq p200 '((200.0 150.0) (200.0 140.0) (200.0 120.0)))
 (setq p225 '((225.0 180.0) (225.0 170.0) (225.0 160.0) (225.0 150.0)))
 (setq p250 '((250.0 200.0) (250.0 180.0) (225.0 170.0) (225.0 160.0)))
 (setq p300 '((300.0 300.0) (300.0 280.0) (300.0 260.0) (300.0 250.0) (300.0 240.0) (300.0 220.0) 
              (300.0 200.0) (300.0 180.0)))
 (setq p375 '((375.0 350.0) (375.0 320.0) (375.0 300.0) (375.0 280.0)))
 (setq p450 '((450.0 400.0) (450.0 370.0) (450.0 350.0) (450.0 320.0)))
 (setq p600 '((600.0 500.0) (600.0 450.0) (600.0 420.0) (600.0 400.0)))  
(if (= t1 150)
 (setq lst(cons p150 lst))
 )
(if (= t2 200)
 (setq lst(cons p200 lst))
 )
(if (= t3 225)
 (setq lst(cons p225 lst))
 )
(if (= t4 250)
 (setq lst(cons p250 lst))
 )
(if (= t5 300)
 (setq lst(cons p300 lst))
 )
(if (= t6 375)
 (setq lst(cons p375 lst))
 )
(if (= t7 450)
 (setq lst(cons p450 lst))
 )
(if (= t8 600)
 (setq lst(cons p600 lst))  
 )
 (setq lst(reverse lst))
)

列表“lst”已成功用于其他地方，以获得最终结果。谢谢你指导我。
芦荟

Lee Mac · 发表于 2022-7-5 17:14:26

我建议如下：

copy


([color=BLUE]defun[/color] c:samp12 ( [color=BLUE]/[/color] bit cnt dch lst rtn )
   ([color=BLUE]setq[/color] lst
      '(
           ((150.0 120.0) (150.0 110.0) (150.0 100.0))
           ((200.0 150.0) (200.0 140.0) (200.0 120.0))
           ((225.0 180.0) (225.0 170.0) (225.0 160.0) (225.0 150.0))
           ((250.0 200.0) (250.0 180.0) (225.0 170.0) (225.0 160.0))
           ((300.0 300.0) (300.0 280.0) (300.0 260.0) (300.0 250.0) (300.0 240.0) (300.0 220.0) (300.0 200.0) (300.0 180.0))
           ((375.0 350.0) (375.0 320.0) (375.0 300.0) (375.0 280.0))
           ((450.0 400.0) (450.0 370.0) (450.0 350.0) (450.0 320.0))
           ((600.0 500.0) (600.0 450.0) (600.0 420.0) (600.0 400.0))
       )
   )
   ([color=BLUE]cond[/color]
       (   ([color=BLUE]<=[/color] ([color=BLUE]setq[/color] dch ([color=BLUE]load_dialog[/color] [color=MAROON]"samp11.dcl"[/color])) 0)
           ([color=BLUE]princ[/color] [color=MAROON]"\nsamp11.dcl not found or could not be loaded."[/color])
       )
       (   ([color=BLUE]not[/color] ([color=BLUE]new_dialog[/color] [color=MAROON]"samp11"[/color] dch))
           ([color=BLUE]princ[/color] [color=MAROON]"\nError in samp11.dcl file."[/color])
       )
       (   ([color=BLUE]setq[/color] bit 1 cnt 1 rtn 0)
           ([color=BLUE]repeat[/color] ([color=blue]length[/color] lst)
               ([color=BLUE]action_tile[/color]
                   ([color=BLUE]strcat[/color] [color=MAROON]"tog"[/color] ([color=BLUE]itoa[/color] cnt))
                   ([color=BLUE]strcat[/color] [color=MAROON]"(setq rtn (boole (+ 4 (* 3 (atoi $value))) "[/color] ([color=BLUE]itoa[/color] bit) [color=MAROON]" rtn))"[/color])
               )
               ([color=BLUE]setq[/color] bit ([color=BLUE]lsh[/color] bit 1) cnt ([color=BLUE]1+[/color] cnt))
           )
           ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]start_dialog[/color]))
               ([color=BLUE]setq[/color] bit 1
                     lst
                   ([color=BLUE]vl-remove-if[/color]
                      '([color=BLUE]lambda[/color] ( x [color=BLUE]/[/color] flg ) ([color=BLUE]setq[/color] flg ([color=BLUE]zerop[/color] ([color=BLUE]logand[/color] bit rtn)) bit ([color=BLUE]lsh[/color] bit 1)) flg)
                       lst
                   )
               )
           )
       )
   )
   ([color=BLUE]if[/color] ([color=BLUE]<[/color] 0 dch) ([color=BLUE]unload_dialog[/color] dch))
   ([color=BLUE]princ[/color])
)

此列表格式更好：

copy


(setq lst
 '(
   ((150.0 120.0) (150.0 110.0) (150.0 100.0))
   ((200.0 150.0) (200.0 140.0) (200.0 120.0))
   ((225.0 180.0) (225.0 170.0) (225.0 160.0) (225.0 150.0))
   ((250.0 200.0) (250.0 180.0) (225.0 170.0) (225.0 160.0))
   ((300.0 300.0) (300.0 280.0) (300.0 260.0) (300.0 250.0) (300.0 240.0) (300.0 220.0) (300.0 200.0) (300.0 180.0))
   ((375.0 350.0) (375.0 320.0) (375.0 300.0) (375.0 280.0))
   ((450.0 400.0) (450.0 370.0) (450.0 350.0) (450.0 320.0))
   ((600.0 500.0) (600.0 450.0) (600.0 420.0) (600.0 400.0))
 )
)

如果每个项目的第一个子项目相同。

Grrr · 发表于 2022-7-5 17:17:25

我想知道你在做什么，可能有更好的方法，如果你看一个管道的流量公式，它包括坡度作为其计算的一部分，给定一个流量，从150开始，你会得到一个坡度答案，如果这是垂直的，然后转到下一个直径，直到它开始给出一个合理的坡度答案，然后你可以说做+或-并锁定管道直径。这是许多民用排水设计软件采用的一种方法，从种子流开始，增加直径。在我们的例子中，是一个带有上下箭头的拨号箱。

我将其用于即时流，只需使用pline绘制管道真实尺寸的圆或通道的形状，并可以水平修剪以计算出明渠尺寸。

copy


(setq lst
 '(
   (150.0 (120.0 110.0 100.0))
   (200.0 (150.0 140.0 120.0))
   (225.0 (180.0 170.0 160.0 150.0))
   (250.0 (200.0 180.0))
   (300.0 (300.0 280.0 260.0 250.0 240.0 220.0 200.0 180.0))
   (375.0 (320.0 300.0 280.0))
   (450.0 (400.0 370.0 350.0 320.0))
   (600.0 (500.0 450.0 420.0 400.0))
 )
)