很抱歉，我表现得很急切。
正如你们在一开始所看到的，我们正在努力学习。
祝你一切顺利。 很乐意帮忙
干杯 Fixo先生，
我试着完成你的Lisp程序。
我失败了。
看来学习编程语言我需要一些时间和对系统变量的完美理解。
如果你能完成（请），我将不胜感激。
真诚地
我明天会尽力完成这段代码，不确定我的空闲时间 再试一次
;; local defuns
(vl-load-com)
(defun run-dialog(leng /)
(setq fn (strcat (getvar "dwgprefix")
(getvar "dwgname")
"waterparams.dcl")
fd (open fn "w"))
(mapcar
(function
(lambda (x)
(princ x fd)
(princ "\n" fd)
)
)
(list
"water : dialog {label=\"Parameters\";"
"fixed_width_font=true;"
": edit_box{label=\"Street\";"
"fixed_width_font=true;"
"key = \"street\";}"
": edit_box{label=\"Length\";"
"fixed_width_font=true;"
(strcat "value=" (rtos leng 2 3) ";")
"key = \"leng\";}"
": list_box {label=\"Math\";"
"fixed_width_font=true;"
"key = \"math\";"
"multiple_select = false;"
"height = 3.6;"
"allow_accept = true;"
"}"
": list_box {label=\"Dia.\";"
"fixed_width_font=true;"
"key = \"dia\";"
"multiple_select = false;"
"height = 3.6;"
"allow_accept = true;"
"}"
"ok_cancel;"
"}"
)
)
(close fd)
(princ)
)
;; convert radians to degrees
(defun rtd (rad)
(/ (* rad 180) pi)
)
;; main part
(defun C:PPW(/ *error* ang cl cr curve dcl_id dia dia_list dia_val
en ent fn fst info leng leng_val lpt lpt1 lpt2 mat math_list
math_val mat_val osm pick pt snd str_val txh txst upt)
(vl-load-com)
(defun *error*(msg)
(if msg(princ msg))
;; stop any command
(while (/= (getvar "cmdactive") 0) (command))
;;restore variables
(if osm
(setvar "osmode" osm))
(if cl
(setvar "clayer" cl))
(if cr
(setvar "cecolor" cr))
(if txst
(setvar "textstyle" txst))
(if txh
(setvar "textsize" txh))
(command "._undo" "E")
)
(setq osm (getvar "osmode"))
(setq cl (getvar "clayer"))
(setq cr (getvar "cecolor"))
(setq txst (getvar "textstyle"))
(setq txh(getvar "textsize"))
(command "._undo" "BE")
(setvar "osmode" 0)
(setvar "textsize" 50.0)
(while (setq ent (entsel "\nSelect pipe-line (or hit Enter to Exit): "))
(if
(member (strcase (cdr (assoc 0 (entget (car ent)))))
(list "LWPOLYLINE" "SPLINE"))
(progn
(setq en (car ent))
(setq curve (vlax-ename->vla-object en))
(setq pt (vlax-curve-getclosestpointto en (cadr ent)))
(setq leng (vlax-curve-getdistatparam en (vlax-curve-getendparam en)))
(run-dialog leng )
(if (not (setq dcl_id (load_dialog fn)))
(exit))
(if (not (new_dialog "water" dcl_id))
(exit))
(start_list "math")
(mapcar 'add_list
(mapcar 'vl-princ-to-string
(setq math_list
(list "AB" "CD" "EF" "GH"))))
(end_list)
(start_list "dia")
(mapcar 'add_list
(mapcar 'vl-princ-to-string
(setq dia_list
(list 100 200 300 400 500))))
(end_list)
(action_tile
"accept"
(strcat "(progn "
"(setq str_val (get_tile \"street\"))"
"(setq leng_val (get_tile \"leng\"))"
"(setq math_val (atoi (get_tile \"math\")))"
"(setq dia_val (atoi (get_tile \"dia\")))"
"(done_dialog 1))")
)
(action_tile "cancel" "(done_dialog 0)")
(setq pick (start_dialog))
(unload_dialog dcl_id)
(vl-file-delete fn)
(if (and (= 1 pick) str_val leng_val math_val dia_val)
(progn
(setq fst (vl-princ-to-string str_val))
(setq snd (rtos (atof leng_val)2 3))
(setq mat (vl-princ-to-string (setq mat_val (nth math_val math_list))))
(setq dia(vl-princ-to-string (setq dia_val (nth dia_val dia_list))))
(setqang (angle
'(0 0 0)
(trans
(vlax-curve-getfirstderiv
curve
(vlax-curve-getparamatpoint curve pt)
)
0 1 t
)
)
)
(setq label
(strcat
"%<\\AcObjProp Object(%<\\_ObjId "
(itoa (vla-get-objectid curve))
">%).Length \\f \"%lu2%pr3\">%"
)
)
;;set text rotation angle to more readable:
(if (< (/ pi 2) ang (* pi 1.5))
(setq ang (+ ang pi))
)
(setq upt (polar pt (+ ang (/ pi 2)) (* (getvar "textsize") 1.5)))
(setq lpt (polar pt (- ang (/ pi 2)) (* (getvar "textsize") 1.5)))
(setq lpt1 (polar lpt (+ ang pi) (getvar "textsize")))
(setq lpt2 (polar lpt ang (getvar "textsize")))
(setq ang (rtd ang))
(setvar "cecolor" "bylayer")
(setvar "clayer" "1 Street")
(command "-mtext" "_non" upt "J" "MC" "H" 50.0 "R" ang "w" 0fst "")
(setvar "clayer" "2 Length")
(command "-mtext" "_non" pt "J" "MC" "H" 50.0 "R" ang "w" 0label "")
(setvar "clayer" "3 Mat")
(command "-mtext" "_non" lpt1 "J" "MR" "H" 50.0 "R" ang "w" 0mat "")
(setvar "clayer" "4 Dia")
(command "-mtext" "_non" lpt2 "J" "ML" "H" 50.0 "R" ang "w" 0(strcat "%%c" dia) "")
)
)
)
)
)
(*error* nil)
(princ)
)
(princ "\n Start command with PPW")
(prin1)
谢谢。
我克服了这个问题。
我不理解VL-，VLA-。。。。，VlAX-。。。。。，
谢谢你，你是一位真正的大师。
恭敬地
嘿，伙计
不要强迫我变红，
我只是一个普通的黑客
不过，不客气，
如果这个例行公事能对你的工作有所帮助，我很高兴
~'J'~ 也许不完全是你想要的，但可能会有所帮助。
LTFly指令。拉链
页:
1
[2]