根据主lsp程序和dcl，求编写一个子程序

lxdz443

下面的是一个填充的程序，现在缺了一个dHATCH的子程序，实在不知道该怎么写了。
主程序;
(Defun C:2 (/ id ls1 ls2 ls3 ls4 bl bl1 bl2)
  (setvar "cmdecho" 0)
  (setvar "blipmode" 0)
  (command "LAYER" "m" "$DXFH" "")
  (setq        id  (load_dialog "2.DCL")
        ls1 (list "i1" "i2" "i3" "i4" "i5" "i6"        "i7" "i8" "i9" "i10"
                  "i11"        "i12")
        ls2 (list "DX(GH7)"         "DX(GH8)"        "DX(GH9)"
                  "DX(GH10)"         "DX(GH11)"        "DX(GH12)"
                  "DX(GH13)"         "DX(GH15)"        "DX(GH14)"
                  "DX(GH16)"         "DX(GH17)"        "DX(GH18)"
                 )
        ls3 (list "i1" "i2" "i3" "i4" "i5" "i6" "i7" "i8")
        ls4 (list "DX(GH30)"          "DX(GH31)"          "DX(GH32)"
                  "DX(GH33)"          "DX(GH34)"          "DX(GH35)"
                  "DX(GH16)"          "DX(GH17)"
                 )
        bl1 (list "GT4"           "GT1"    "GT2"    "GT3"    "GT5"    "GT7"
                  "GT10"   "GT11"   "GT6"    "HL1"    "HL2"    "GT12"
                 )
        bl2 (list "AR-SAND"   "AR-CONC"          "STONE"     "STONE1"
                  "ANSI31"    "ER-SAND"          "HL1"              "HL2"
                 )
  )
  (while (/= s1 0)
    (if        (and (= s1 20) (/= s1 13))
      (progn (if (not (new_dialog "DX2" id))
               (exit)
             )
             (mapcar '(lambda (x y) (ima x y)) ls3 ls4)
             (setq bl bl2)
      )
      (progn (if (not (new_dialog "DX" id))
               (exit)
             )
             (mapcar '(lambda (x y) (ima x y)) ls1 ls2)
             (setq bl bl1)
      )
    )
    (action_tile "i1" "(done_dialog 1)")
    (action_tile "i2" "(done_dialog 2)")
    (action_tile "i3" "(done_dialog 3)")
    (action_tile "i4" "(done_dialog 4)")
    (action_tile "i5" "(done_dialog 5)")
    (action_tile "i6" "(done_dialog 6)")
    (action_tile "i7" "(done_dialog 7)")
    (action_tile "i8" "(done_dialog 8)")
    (action_tile "i9" "(done_dialog 9)")
    (action_tile "i10" "(done_dialog 10)")
    (action_tile "i11" "(done_dialog 11)")
    (action_tile "i12" "(done_dialog 12)")
    (action_tile "Next" "(done_dialog 20)")
    (action_tile "Last" "(done_dialog 13)")
    (action_tile "cancel" "(done_dialog 0)")
    (setq s1 (start_dialog))
    (if        (and (>= s1 1) (<= s1 12))
      (set2 (nth (1- s1) bl))
    )
  )
  (setvar "clayer" "0")
  (setq s1 nil)
  (unload_dialog id)
  (princ)
)


(Defun ima (a b / x y)
  (setq        x (dimx_tile a)
        y (dimy_tile a)
  )
  (start_image a)
  (fill_image 0 0 x y 0)
  (slide_image 0 0 x y b)
  (end_image)
)


(Defun set2 (a / s1 b p1 p2 ss)
  (if (not (new_dialog "DX1" id))
    (exit)
  )
  (action_tile  "accept" "(setq b (get_tile \"B\")k (get_tile \"EP\"))  (done_dialog 1)")
  (action_tile  "ry" "(setq b (get_tile \"B\")k (get_tile \"EP\")) (done_dialog 3)" )
  (action_tile  "tc" "(setq b (get_tile \"B\") k (get_tile \"EP\")) (done_dialog 2)" )
  (action_tile  "cancel" "(setq b (get_tile \"B\")) (done_dialog 0)")
  (setq s1 (start_dialog))
  (if (> s1 0)
    (progn
      (cond
        ((= s1 1)
         (initget 1)
         (setq p1 (getpoint "\n填充区域第一角:"))
         (initget 1)
         (setq p2 (getcorner p1 "\n另一角:"))
         (command "Pline"
                  p1
                  (list (car p1) (cadr p2))
                  p2
                  (list (car p2) (cadr p1))
                  "C"
         )
          (dHATCH a
                 (atof b)
                 0
                 (setq e (entlast))
                 (if (= k "1")
                   T
                   nil
                )
         )
         (command "ERASE" E "")
        )
        ((= s1 3)
         (princ "\n绘填充轮廓线:")
         (setvar "plinewid" 0)
         (setvar "cecolor" "1")
         (command "pline")
         (initget 1)
         (setq p1 (getpoint "\n第一点:")
               ls '(("STONE1" 10) ("ANSI31" 10) ("AR-CONC" 1) ("AR-SAND" 5))
               pl (list p1)
               s  2
         )
         (command p1)
         (while
           (progn
             (initget "U C")
             (and s
                  (setq
                    p2 (getpoint
                         (car pl)
                         "\n下一点 / U 回退一步 / C 闭合 / Enter 结束:"
                       )
                  )
             )
           )
            (command p2)
            (if        (= p2 "C")
              (setq s nil)
              (if (listp p2)
                (setq pl (cons p2 pl))
                (setq pl (cdr pl))
              )
            )
         )
         (if s
           (command "c")
         )
         (setvar "cecolor" "bylayer")
         (setq e (entlast))
         (dHATCH A
                 (atof b)
                 0
                 e
                 (if (= k "1")
                   T
                   nil
                 )
         )
         (command "ERASE" E "")
        )
        ((= s1 2)
         (princ "\n选取图形为填充区域边界.")
         (GC)
         (setq ss (ssget))
         (if ss
           (dHATCH A
                   (atof b)
                   0
                   ss
                   (if (= k "1")
                     T
                     nil
                   )
           )
         )
        )
      )
    )
    (setq s 0)
  )
)


DCL：

DX : dialog {
              label = "地形图案示意";

      : text_part {
                     label = "选择填充的地形符号";
        }
                          
      : row {
         
           : image_button {
                           key = "i1";
                                 width = 12;
                                 aspect_ratio = 1;
           }
          
           : image_button {
                           key = "i2";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
          
           : image_button {
                           key = "i3";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }               
          
           : image_button {
                           key = "i4";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }      
        }
       
      : row {
         
           : text_part {
                        label = "   草地";
           }
          
           : text_part {
                        label = " 旱田一";
           }
          
           : text_part {
                        label = " 旱田二";
           }      
          
           : text_part {
                        label = "   水田";
           }               
        }
       
      : row {
         
           : image_button {
                           key = "i5";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
          
           : image_button {
                           key = "i6";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
          
           : image_button {
                           key = "i7";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }

           : image_button {
                           key = "i8";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
                  
        }
       
      : row {
         
           : text_part {
                        label = "    树林";
           }
          
           : text_part {
                        label = "    竹林";
           }
          
           : text_part {
                        label = "   果园(苹果)";
           }
          
           : text_part {
                        label = " 果园(梨)";
           }               
        }      
       

      : row {
         
           : image_button {
                           key = "i9";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
          
           : image_button {
                           key = "i10";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
          
           : image_button {
                           key = "i11";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
          
           : image_button {
                           key = "i12";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }               
          
                  
        }
       
      : row {

           : text_part {
                        label = "      灌木";
           }               
         
           : text_part {
                        label = " 横向水流";
           }
          
           : text_part {
                        label = " 纵向水流";
           }
          
           : text_part {
                        label = " 泥浆、沼泽";
           }
          
        }      
       
      spacer_1;
       
    : row {

      spacer_1;

        : cancel_button {
                         label = "剖面形式";
                             key = "Next";
        }
       
      spacer_1;
       
        : cancel_button {
                         label = "退出";
                             key = "cancel";
        }
               
      spacer_1;         
       
        }
  }

DX2 : dialog {
              label = "剖面地形图案示意";

      : text_part {
                     label = "选择填充的地形符号";
        }
                          
      : row {
         
           : image_button {
                           key = "i1";
                                 width = 12;
                                 aspect_ratio = 1;
           }
          
           : image_button {
                           key = "i2";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
          
           : image_button {
                           key = "i3";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }               
          
           : image_button {
                           key = "i4";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }      
        }
       
      : row {
         
           : text_part {
                        label = " 砂土";
           }
          
           : text_part {
                        label = " 混凝土";
           }
          
           : text_part {
                        label = " 毛石";
           }      
          
           : text_part {
                        label = " 砌片石";
           }               
        }
       
      : row {
         
           : image_button {
                           key = "i5";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
          
           : image_button {
                           key = "i6";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
          
           : image_button {
                           key = "i7";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }

           : image_button {
                           key = "i8";
                                 width = 12;
                                 aspect_ratio = 1;                              
           }
                  
        }
       
      : row {
         
           : text_part {
                        label = " 普通土";
           }
          
           : text_part {
                        label = " 沙砾土";
           }
          
           : text_part {
                        label = " 横向水流";
           }
          
           : text_part {
                        label = " 纵向水流";
           }               
        }      

    spacer_1;

    : row {

      spacer_1;

        : cancel_button {
                         label = "平面形式";
                             key = "Last";
        }
       
      spacer_1;
       
        : cancel_button {
                         label = "退出";
                             key = "cancel";
        }
               
      spacer_1;         
       
        }
       
  }  

DX1 : dialog {
               label = "填充操作";
               initial_focus = "B";   
    : row {
                  
     : edit_box {
                 label = "填充比例: ";
                     edit_width = 6;
                     key = "B";
                     value = "10";
     }

     : toggle {
               label = "打碎图案";
               key = "EP";
               value = "1";

     }     
    }

     : boxed_row {
                 label = "选择添充区域";     

         spacer_1;
          
         : ok_button {
                       label = "矩形区域";
                           key = "accept";
           }
          
         spacer_1;
          
          
         : button {
                       label = "任意区域";
                           key = "ry";
           }
          
         spacer_1;         

         : button {
                     label = "图形区域";
                     key = "tc";
           }
                          
         spacer_1;
          
     }


         : cancel_button {
                     label = "退出";
                     key = "cancel";
           }     

    }  32

Gu_xl

试试这个：
(defun dHATCH (a b c d e)
  (command "bhatch" "p" a b c "s" d "" "")
  (if e (command "explode" (entlast)))
  )

lxdz443

高手，问题直接解决了。谢谢。

烟盒迷唇

很不错，可以批量填充了