根据主lsp程序和dcl，求编写一个子程序
下面的是一个填充的程序，现在缺了一个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)
s2
)
(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
试试这个：
(defun dHATCH (a b c d e)
(command "bhatch" "p" a b c "s" d "" "")
(if e (command "explode" (entlast)))
) 高手，问题直接解决了。谢谢。 很不错，可以批量填充了
页:
[1]