（完成） [编程申请]：水利水电工程桩号标程序

msdg · 发表于 2003-6-11 09:54:21

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

十分感谢EACHY先生为水利水电工程专业付出的辛勤劳动！请再为我们做一个桩号标注程序，如图：
要求能设定做图比例、能自定义桩号间距、能改正设计轴线长度（因各种因素，实测长度往往和画出的长度有一点点差异，一般是以实测为准）。
以前我是用ME命令插块的方式做的，但每个桩号都要改值，桩号多了容易出错。
以上为初步想法，请各位同行补充、完善。以便使XDSOFT、EACHY先生编程时能统筹考虑，避免重复劳动。

lzfat · 发表于 2003-6-11 21:29:15

我已经编制出来啦，到水利论坛去找找，基本上你得要求我都满足了，因为我是水利人，所以在实际工作中自己也总结了一些经验，呵呵，谢谢啊！

地址：
http://www.xdcad.net/forum/showthread.php?s=&threadid=34050

eachy · 发表于 2003-6-12 16:44:10

最初由 msdg 发布
[B]十分感谢EACHY先生为水利水电工程专业付出的辛勤劳动！请再为我们做一个桩号标注程序，如图：
要求能设定做图比例、能自定义桩号间距、能改正设计轴线长度（因各种因素，实测长度往往和画出的长度有一点点差异，一?.. [/B]

;|
命令： XDTB_DmZh
功能：标注桩号
注意：标注方向与曲线方向有关，不符要求时先行对曲线转向
程序中为了提高标注速度使用了VLisp，对R14下的用户;
可以注释掉Vlisp改用text 命令
|;
(if (not $xdtb_globle_scale)
(setq $xdtb_globle_scale 1.)
)
(defun c:XDTB_DmZh (/ e str st1 st2 s_l ptl pangle modelspace $ea_textlength $zero $zero1 p1 p2 len !last st0)
(defun $ea_textlength (str)
(caadr
(textbox
(list (cons 40 (* 3. $xdtb_globle_scale))
(cons 1 str)
'(7 . "xdtb_efont")
)
)
)
)
(defun !last (l) (reverse (cdr (reverse l))))
(setq modelspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object))))
($XDLSP_CHECKFONT)
(xdrx_begin)
(xdrx_ucson)
(xdrx_sysvar_push "osmode" "textstyle")
(setq e (xdrx_entsel "\n选择中心线: " '((0 . "*line,arc"))))
(if e
(progn
(setq str (getstring "\n输入前缀、起始桩号及间距[用逗号分隔]: "))
(setq st0 (car (xdrx_string_tok str ","))
st1 (cadr (xdrx_string_tok str ","))
st2 (last (xdrx_string_tok str ","))
s_l (strlen st2)
)
(setq ptl (xdrx_getpointatdist (car e) (float (read st2))))
(setq
pangle
(mapcar '(lambda (x) (cadr (xdrx_getperpline (car e) x)))
ptl
)
)
(setq p1 (car (reverse ptl))
p2 (cadr (reverse ptl))
len (xdrx_curve_getdistatpoint (car e) p1 p2))
(if (/= len (read st2))
(progn
(setq ptl (!last ptl))
(setq pangle (!last pangle))
)
)
(setq $zero "")
(repeat s_l (setq $zero (strcat "0" $zero)))
(setq $zero1 $zero)
(setvar "textstyle" "xdtb_efont")
(mapcar
'(lambda (x y / string obj)
(setq string (strcat st0 st1 "+" $zero))
(xdrx_line1
x
(polar x
y
(+ ($ea_textlength string)
(* 2 $xdtb_globle_scale)
)
)
)
(setq
obj (vla-addtext
modelspace
string
(vlax-3d-point
(polar x (+ y _pi4) (* 1.414 $xdtb_globle_scale))
)
(* 3 $xdtb_globle_scale)
)
)
(vla-put-rotation obj y)
;|(command ".text"
(polar x (+ y _pi4) (* 1.414 $xdtb_globle_scale))
(* 3 $xdtb_globle_scale)
($xdlsp_rtd y)
string
)|;
(setq $zero (rtos (+ (read $zero) (read st2)) 2 0))
(if (> (strlen $zero) s_l)
(progn
(setq st1 (rtos (1+ (read st1)) 2 0))
(setq $zero $zero1)
)
)
)
ptl
pangle
)
)
)
(xdrx_sysvar_pop)
(xdrx_ucsoff)
(xdrx_end)
(princ)
)

;| 
命令： XDTB_DmZh 
功能： 标注桩号 
注意： 标注方向与曲线方向有关，不符要求时先行对曲线转向 
       程序中为了提高标注速度使用了VLisp，对R14下的用户; 
       可以注释掉Vlisp改用text 命令 
|; 
(if (not $xdtb_globle_scale) 
  (setq $xdtb_globle_scale 1.) 
) 
(defun c:XDTB_DmZh (/ e str st1 st2 s_l ptl pangle modelspace $ea_textlength $zero $zero1 p1 p2 len !last st0) 
  (defun $ea_textlength        (str) 
    (caadr 
      (textbox 
        (list (cons 40 (* 3. $xdtb_globle_scale)) 
              (cons 1 str) 
              '(7 . "xdtb_efont") 
        ) 
      ) 
    ) 
  ) 
  (defun !last (l) (reverse (cdr (reverse l)))) 
  (setq modelspace (vla-get-modelspace (vla-get-activedocument (vlax-get-acad-object)))) 
  ($XDLSP_CHECKFONT) 
  (xdrx_begin) 
  (xdrx_ucson) 
  (xdrx_sysvar_push "osmode" "textstyle") 
  (setq e (xdrx_entsel "\n选择中心线: " '((0 . "*line,arc")))) 
  (if e 
    (progn 
      (setq str (getstring "\n输入前缀、起始桩号及间距[用逗号分隔]: ")) 
      (setq st0 (car (xdrx_string_tok str ",")) 
               st1        (cadr (xdrx_string_tok str ",")) 
            st2        (last (xdrx_string_tok str ",")) 
            s_l        (strlen st2) 
      ) 
      (setq ptl (xdrx_getpointatdist (car e) (float (read st2)))) 
       
      (setq 
        pangle 
         (mapcar '(lambda (x) (cadr (xdrx_getperpline (car e) x))) 
                 ptl 
         ) 
      ) 
      (setq p1 (car (reverse ptl)) 
            p2 (cadr (reverse ptl)) 
            len (xdrx_curve_getdistatpoint (car e) p1 p2)) 
      (if (/= len (read st2)) 
        (progn 
          (setq ptl (!last ptl)) 
          (setq pangle (!last pangle)) 
        ) 
      ) 
      (setq $zero "") 
      (repeat s_l (setq $zero (strcat "0" $zero))) 
      (setq $zero1 $zero) 
      (setvar "textstyle" "xdtb_efont") 
      (mapcar 
        '(lambda (x y / string obj) 
           (setq string (strcat st0 st1 "+" $zero)) 
           (xdrx_line1 
             x 
             (polar x 
                    y 
                    (+ ($ea_textlength string) 
                       (* 2 $xdtb_globle_scale) 
                    ) 
             ) 
           ) 
           (setq 
             obj (vla-addtext 
                   modelspace 
                   string 
                   (vlax-3d-point 
                     (polar x (+ y _pi4) (* 1.414 $xdtb_globle_scale)) 
                   ) 
                   (* 3 $xdtb_globle_scale) 
                 ) 
           ) 
           (vla-put-rotation obj y) 
           ;|(command ".text" 
                    (polar x (+ y _pi4) (* 1.414 $xdtb_globle_scale)) 
                    (* 3 $xdtb_globle_scale) 
                    ($xdlsp_rtd y) 
                    string 
           )|; 
           (setq $zero (rtos (+ (read $zero) (read st2)) 2 0)) 
           (if (> (strlen $zero) s_l) 
             (progn 
               (setq st1 (rtos (1+ (read st1)) 2 0)) 
               (setq $zero $zero1) 
             ) 
           ) 
         ) 
        ptl 
        pangle 
      ) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_ucsoff) 
  (xdrx_end) 
  (princ) 
)

lzfat · 发表于 2003-6-13 09:46:00

给我的感觉好像都在使用晓东的api？那是不是一定要安装晓东工具箱才可以实现这个功能呢？

chenhang1203 · 发表于 2003-6-13 09:53:17

无法下载了啊，能再提供一次吗

lzfat · 发表于 2003-6-13 11:47:48

不是下载的，是那位兄弟将源码贴出来了啊，自己拷贝回去存盘就行了，

eachy · 发表于 2003-6-13 12:08:55

最初由 lzfat 发布
[B]给我的感觉好像都在使用晓东的api？那是不是一定要安装晓东工具箱才可以实现这个功能呢？ [/B]

不需要那么多功能可以只加载xdrx_api和xdlsp.lsp，上面的程序就可以用。

ljb · 发表于 2003-6-16 22:07:02

错误: no function definition: $XDLSP_CHECKFONT
不明白

chenhang1203 · 发表于 2003-6-20 16:52:41

输入命令很不方便啊

eachy · 发表于 2003-6-22 01:25:33

最初由 ljb 发布
[B]错误: no function definition: $XDLSP_CHECKFONT
不明白 [/B]

你没有或者XDLSP.lsp 文件太旧了，下载更新文件。

ljb · 发表于 2003-7-2 00:29:24

太麻烦了。

eachy · 发表于 2003-7-2 00:35:43

最初由 ljb 发布
[B]太麻烦了。 [/B]

图不用自己画程序别人写最不麻烦了。

3602705 · 发表于 2003-8-24 18:13:38

是公路的就好了

eachy · 发表于 2003-8-25 12:28:34

最初由 3602705 发布
[B]是公路的就好了 [/B]

说说公路的是什么样子？

wjphd · 发表于 2004-9-8 18:19:27

错误:no function definition: $XDLSP_CHECKFONT 怎么加载不成功啊！我是用记事本保存lsp啊

账号		自动登录	找回密码
密码			立即注册

（完成） [编程申请]：水利水电工程桩号标程序

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

相关帖子

Re: [编程申请]：水利水电工程桩号标程序