最初由 msdg 发布
[B]XDSOFT、EACHY:
在水利水电工程设计中,经常会遇到如题问题。ZDM3。0中有这个功能,经实际运用,发现其有不足之处,主要表现在:1、切剖面只能剖直线,不能剖曲线。2、经常会多处漏切,即使按其提示办法也不能完全... [/B]
先写了个等高线赋值。

- (if (not $xdtb_globle_high1)
- (setq $xdtb_globle_high1 "10")
- )
- (if (not $xdtb_globle_high2)
- (setq $xdtb_globle_high2 "1")
- )
- (if (not $XDTB_globle_scale)
- (setq $XDTB_globle_scale 1.)
- )
- (defun $set_high (/ hig)
- (princ "\n输入起始高程[H]或高程与高差[H,h]...")
- (setq hig (getstring "\n输入高程或高程、高程或高差: "))
- (cond
- ((= (substr hig 1 1) ",")
- (setq $xdtb_globle_high2 (substr hig 2))
- )
- ((xdrx_string_find hig ",")
- (setq $xdtb_globle_high1 (car (xdrx_string_tok hig ","))
- $xdtb_globle_high2 (cadr (xdrx_string_tok hig ","))
- )
- )
- (t (setq $xdtb_globle_high1 hig))
- )
- )
- ;;等高线赋值
- (defun c:XDTB_FZ (/ $_setxdata tf e p1 p2 pint ss tf0 e1 hig)
- (defun $_setxdata (e p tf1 h / ang txt e1 ln)
- (if (> tf1 1)
- (setq $xdtb_globle_high1
- (rtos (+ (read $xdtb_globle_high1)
- (read $xdtb_globle_high2)
- )
- 2
- 0
- )
- )
- )
- (setq ang ($xdlsp_angle_format
- (car (xdrx_getperpline e p))
- )
- )
- (command ".text"
- "j"
- "mc"
- p
- (* 2.5 $XDTB_globle_scale)
- ($xdlsp_rtd ang)
- $xdtb_globle_high1
- )
- (setq na (cadr (xdrx_object_classname e)))
- (setq txt (entlast)
- ln (list e p)
- )
- (command ".trim" txt "" ln "")
- (setq e1 (entlast))
- (if (= (cadr (xdrx_object_classname e1)) na)
- (xdrx_setxdata e1 "Yb_high" (if h h $xdtb_globle_high1))
- )
- (xdrx_setxdata e "Yb_high" (if h h $xdtb_globle_high1))
- )
- (xdrx_begin)
- (xdrx_ucson)
- (xdrx_sysvar_push "osmode")
- (setvar "dimzin" 0)
- (setvar "osmode" 0)
- (setq tf t)
- (while tf
- (princ (strcat "\n当前高程 H="
- (if h1
- h1
- $xdtb_globle_high1
- )
- ", 高差 h="
- $xdtb_globle_high2
- )
- )
- (initget 128 "F S M")
- (setq e (xdrx_entsel
- "\n选择等高线[S - 设置 / F - 多选 / M - 匹配]<Exit>: "
- '((0 . "*line,arc,circle,ellipse"))
- )
- )
- (cond
- ((= e "S")
- ($set_high)
- )
- ((= e "F")
- (princ "\n注意: 按递增方向选择.....")
- (if (and (setq p1 (getpoint "\n第一点: "))
- (setq p2 (getpoint p1 "\n第二点: "))
- )
- (progn
- (xdrx_line1 p1 p2)
- (setq ent1 (entlast))
- (setq ss (ssget "F" (list p1 p2) '((0 . "*line,arc,circle,ellipse"))))
- (xdrx_setsstodb ss 0)
- (while (setq e1 (xdrx_getentdata 0))
- (if (not tf0)
- (setq tf0 1)
- )
- (setq pint (xdrx_getinters e1 ent1 0))
- ($_setxdata e1 (car pint) tf0 nil)
- (setq tf0 (1+ tf0))
- )
- (xdrx_entity_delete ent1)
- )
- )
- )
- ((= e "M")
- (setq
- e (xdrx_entsel "\n选择已赋值的等高线: " '((-3 ("YB_high"))))
- )
- (setq hig (xdrx_getxdata (car e) "YB_high"))
- (setq e1 (xdrx_entsel
- "\n选择目标等高线: "
- '((0 . "*line,arc,circle,ellipse"))
- )
- )
- ($_setxdata (car e1) (cadr e1) 2 hig)
- )
- ((= (type e) 'STR)
- (princ "\n输入错误!")
- )
- ((= (type e) 'LIST)
- (progn
- (if (not tf0)
- (setq tf0 1)
- )
- (setq pint (cadr (xdrx_curve_ClosestPoint (car e) (cadr e)))
- )
- ($_setxdata (car e) pint tf0 nil)
- (setq tf0 (1+ tf0))
- )
- )
- (t (setq tf nil))
- )
- )
- (xdrx_sysvar_pop)
- (xdrx_ucsoff)
- (xdrx_end)
- (princ)
- )
|