根据坡度动态标注标高

searinon · 发表于 2017-8-16 09:18:57

厉害了我的哥。

brainstorm · 发表于 2017-8-16 16:12:41

本帖最后由 brainstorm 于 2017-8-16 20:24 编辑

修改了一下，用API的一键回车控制块旋转角度，没按一次A增加90度，
按S键退出程序，附件是更新的代码。

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:000.rar
下载次数:75 文件大小:3.92 KB
下载权限: 不限以上 [免费赚D豆]

liuyj · 发表于 2017-8-16 19:23:28

附件里的文件不对吧？lsp文件就是N版的例子，不是一楼的程序

brainstorm · 发表于 2017-8-16 20:29:56

liuyj 发表于 2017-8-16 19:23

我更新了附件，下载看看
改变比例后图块大小调整正常了。

另外有个奇怪的现象，采用打包的vlx文件。我已经设置dcl-congtrol-setkeepfocus 为nill,当鼠标离开对话框，
依然需要在屏幕上点下鼠标或滚轮。当我用vlide打开编辑器，就恢复正常了。
N版帮忙看看是怎么回事。

newer · 发表于 2017-8-16 22:04:26

brainstorm 发表于 2017-8-16 20:29

设计对话框的时候，保持焦点别勾上。

spp_wall · 发表于 2017-8-17 14:55:05

支持！！！！！！！！！！！！！

brainstorm · 发表于 2017-8-21 17:03:03

本帖最后由 brainstorm 于 2017-8-21 17:05 编辑

这是个完整版，主要修改：
采用一键回车方式支持：
1 重新选点
2 图取标高值
3 取上一点位置及标高值作为新的起点
以上也就是支持变坡度
createnewblock函数全部采用API函数定义
非模态对话框位置始终保留在左上角，没有加判断上次在什么位置，因为对话框很小，感觉没必要
对话框还是原来那个，从以前的帖子下载即可
QQ截图20170821170339.png

(defun c:dlbg (/ *error* AN
CURVE DIST dwgScale
E E0 E1
F1 LOOP LTH
P1 PA SLOPE
STARTELE STARTP
c:RD_ele/form1#OnMouseEntered rtn
zgx-getdistoncurve
c:RD_ele/form1#OnMouseMovedOff oldE
oldP firsttime newEleValue
osmodeValue
)
(command "_opendcl")
;;;---odlc form ----------------------------------------------------------------
(if (not $projecAlreadyLoaded)
(progn
(dcl-project-load "rd_ele")
(setq $projecAlreadyLoaded t)
)
)
;;;---function of odcl events----------------------------------------------------
(defun c:RD_ele/form1#OnMouseEntered (/)
(dcl-control-setfocus RD_ele/form1)
)
(defun c:RD_ele/form1/Label4#OnClicked (/)
(if (equal 0 (dcl-control-getvalue RD_ele/form1/checkbox1))
(dcl-control-setvalue RD_ele/form1/checkbox1 1)
(dcl-control-setvalue RD_ele/form1/checkbox1 0)
)
)
(defun c:RD_ele/form1#OnMouseMovedOff (/)
(setq slope (atof (dcl-control-gettext rd_ele/form1/textbox1))
startEle (atof (dcl-control-gettext rd_ele/form1/textbox2))
dwgScale (atof (dcl-control-gettext rd_ele/form1/textbox3))
)
(vlax-ldata-put "tcc_dwg_setting" "dwg_scale" dwgScale)
(princ "\nmove off the form")
(if e
(progn (entdel e)
(setq
e (xdrx_insert_make "$ele_symbol" p1 (/ dwgScale 100.0) 0)
)
)
)
(xdrx_setenttodb e)
(dcl-control-setkeepfocus rd_ele/form1 nil)
(redraw)
)
;;;-error function---------------------------------------------------------------
;;;------------------------------------------------------------------------------
(defun *error* (msg)
(if (dcl-form-isactive rd_ele/form1)
(dcl-form-close rd_ele/form1)
)
(if e
(entdel e)
)
(xdrx_sysvar_pop)
(princ "\n 程序退出 ... ... ... ... ")
(princ)
)
;;;--Create a block function-----------------------------------------------------
;;;------------------------------------------------------------------------------
(defun addNewBlock (name / ss e e1)
(xdrx_setmark)
(xdrx_polyline_make
'((0 0 0) (300 300 0) (-300 300 0) (0 0 0))
)
(xdrx_setpropertyvalue
(setq e (xdrx_AttributeDef_make
(xdrx_text_make '(0 400.0 0.0) "ELE_symbol" 300 0)
t
)
)
"textstring"
"%%p0.000"
)
(xdrx_text_setproperty
e
"AlignPoint"
'(0
400.0
0.0
)
"HozMode"
1
"VerMode"
0
"WidthFactor"
0.7
)
(setq ss (xdrx_getss))
(xdrx_block_make name ss '(0 0 0))
(xdrx_object_delete ss)
)
;;;---callback function------------------------------------------------------------
;;;--------------------------------------------------------------------------------
(vl-acad-defun 'dragtext)
(defun dragtext (p)
(setq p1 (xdrx_curve_getclosestpoint curve p)
f1 (xdrx_curve_getfirstderiv
curve
(xdrx_curve_getparamatpoint curve p1)
)
dist (zgx-getdistoncurve
curve
p1
startp
)
an
(xdrx_vector_angle f1)
an
(xd::geom:angleformat an)
)
;;;---Using vl functions----------------------------------------------------------
(setq e1 (vlax-ename->vla-object e))
(xdrx_text_setstring
(car (xdrx_insert_getattribs e))
(rtos (+ startEle (* dist slope 1e-3)) 2 3)
)
(vla-put-rotation e1 (+ (* kk 0.5 pi) an))
(vla-put-InsertionPoint e1 (vlax-3d-point p1))
)
;;;---------------------------------------------------------------------------------
;;;---此处也可改为xdrx_curve_对应的函数，因为API已经调整，支持对spline取得距离
(defun zgx-getdistoncurve (e pt1 pt2 / rtn)
(abs (setq rtn (-
(vlax-curve-getdistatpoint e pt2)
(vlax-curve-getdistatpoint e pt1)
)
)
)
)
;;;---end of dragtext ,main program starts-----------------------------------------
(xdrx_begin)
(if (not (tblsearch "block" "$ele_symbol"))
(ADDNEWBLOCK "$ele_symbol")
)
;;;---此处加判断cad版本，是因为在cad2010下如果不关闭捕捉----------------
;;;---会出现崩溃情况--------------------------------------------------------------------
(if (member (XD::Doc:AppVer) '(19))
(setq osmodeValue 703)
(setq osmodeValue 0)
)
(xdrx_sysvar_push
'("orthomode" 0)
'("autosnap" 55)
(list "osmode" osmodeValue)
)
(and (setq e0 (entsel "\n在起点附件选取曲线:"))
(setq curve (car e0))
(setq p1 (cadr e0))
(setq lth (xdrx_curve_getdistatparam
curve
(xdrx_curve_getendparam curve)
)
)
)
(setq startp (if (< (setq pa
(xdrx_curve_getparamatpoint
curve
p1
)
)
(* 0.5 (vlax-curve-getendparam curve))
)
(vlax-curve-getStartPoint curve)
(vlax-curve-getendPoint curve)
)
)
(setq loop t
kk 0
)
;;;---------------------------------------------------------------------------------
(dcl-form-show rd_ele/form1)
(dcl-form-setpos
rd_ele/form1
(car (last (xdrx_document_pixelbox)))
(cadr (last (xdrx_document_pixelbox)))
)
(if (setq
dwgScale (vlax-ldata-get "tcc_dwg_setting" "dwg_scale")
)
(dcl-control-settext
rd_ele/form1/textbox3
(rtos dwgscale 2 0)
)
(progn
(dcl-control-settext rd_ele/form1/textbox3 "100")
(setq dwgScale "100")
(vlax-ldata-put "tcc_dwg_setting" "dwg_scale" dwgScale)
)
)
(dcl-control-setkeepfocus rd_ele/form1 nil)
(setq firsttime t)
(while loop
(setq slope (atof (dcl-control-gettext rd_ele/form1/textbox1))
startEle (atof (dcl-control-gettext rd_ele/form1/textbox2))
dwgScale (atof (dcl-control-gettext rd_ele/form1/textbox3))
)
(vlax-ldata-put "tcc_dwg_setting" "dwg_scale" dwgScale)
(xdrx_initget "s a d f")
(setq e (xdrx_insert_make "$ele_symbol" p1 (/ dwgScale 100.0) 0))
(if firsttime
(setq oldE e)
)
(setq rtn
(xdrx_drag_jig
"dragtext"
"\n选择标注位置[设上一点为新起点标高(S)/旋转(A)/重新选点(D)/图取标高值(F)<退出>]"
"s a d f"
(+ 2 128)
0
p1
)
)
(cond
((equal (type rtn) 'list)
(progn (setq loop t)
(progn (setq firsttime nil) (setq oldE (entlast)))
)
)
((eq rtn -1)
(progn (setq loop nil)
(if e
(entdel e)
)
(if (dcl-form-isactive rd_ele/form1)
(dcl-form-close rd_ele/form1)
)
)
)
((eq (strcase rtn) "D")
(progn
(if e
(entdel e)
)
(xdrx_initget)
(setq startp (getpoint "\n选择新的起点"))
)
)
((eq (strcase rtn) "S")
(progn
(if (not firsttime)
(progn
(dcl-control-settext
rd_ele/form1/textbox2
(xdrx_text_string (car (xdrx_insert_getattribs oldE)))
)
(setq startp (xdrx_getpropertyvalue oldE "position"))
)
)
(if e
(entdel e)
)
)
)
((equal (strcase rtn) "A")
(progn (setq loop t)
(if (< kk 3)
(setq kk (1+ kk))
(setq kk 0)
)
(entdel (entlast))
)
)
((equal (strcase rtn) "F")
(progn (setq loop t)
(if (setq newEleValue (car (entsel "\n图取标高:")))
(dcl-control-settext
rd_ele/form1/textbox2
(xdrx_getpropertyvalue
(car (xdrx_insert_getattribs newEleValue))
"textstring"
)
)
)
(entdel (entlast))
)
) ;eq q
((eq (type rtn) 'str)
(xdrx_initget)
)
)
)
(if (equal -4 rtn)
(progn
(if (dcl-form-isactive rd_ele/form1)
(dcl-form-close rd_ele/form1)
)
)
)
(xdrx_sysvar_pop)
(xdrx_end)
)

(defun c:dlbg (/               *error*               AN 
               CURVE               DIST               dwgScale 
               E               E0               E1 
               F1               LOOP               LTH 
               P1               PA               SLOPE 
               STARTELE               STARTP 
               c:RD_ele/form1#OnMouseEntered   rtn 
               zgx-getdistoncurve 
               c:RD_ele/form1#OnMouseMovedOff  oldE 
               oldP               firsttime       newEleValue 
               osmodeValue 
              ) 
  (command "_opendcl") 
;;;---odlc form ---------------------------------------------------------------- 
  (if (not $projecAlreadyLoaded) 
    (progn 
      (dcl-project-load "rd_ele") 
      (setq $projecAlreadyLoaded t) 
    ) 
  ) 
;;;---function of odcl events---------------------------------------------------- 
 
  (defun c:RD_ele/form1#OnMouseEntered (/) 
    (dcl-control-setfocus RD_ele/form1) 
  ) 
 
  (defun c:RD_ele/form1/Label4#OnClicked (/) 
    (if        (equal 0 (dcl-control-getvalue RD_ele/form1/checkbox1)) 
      (dcl-control-setvalue RD_ele/form1/checkbox1 1) 
      (dcl-control-setvalue RD_ele/form1/checkbox1 0) 
    ) 
  ) 
 
  (defun c:RD_ele/form1#OnMouseMovedOff        (/) 
 
    (setq slope           (atof (dcl-control-gettext rd_ele/form1/textbox1)) 
          startEle (atof (dcl-control-gettext rd_ele/form1/textbox2)) 
          dwgScale (atof (dcl-control-gettext rd_ele/form1/textbox3)) 
    ) 
    (vlax-ldata-put "tcc_dwg_setting" "dwg_scale" dwgScale) 
    (princ "\nmove off the form") 
    (if        e 
      (progn (entdel e) 
             (setq 
               e (xdrx_insert_make "$ele_symbol" p1 (/ dwgScale 100.0) 0) 
             ) 
      ) 
    ) 
    (xdrx_setenttodb e) 
    (dcl-control-setkeepfocus rd_ele/form1 nil) 
    (redraw) 
  ) 
 
;;;-error function--------------------------------------------------------------- 
;;;------------------------------------------------------------------------------ 
  (defun *error* (msg) 
    (if        (dcl-form-isactive rd_ele/form1) 
      (dcl-form-close rd_ele/form1) 
    ) 
    (if        e 
      (entdel e) 
    ) 
    (xdrx_sysvar_pop) 
    (princ "\n 程序退出 ... ... ... ... ") 
    (princ) 
  ) 
 
;;;--Create a block function----------------------------------------------------- 
;;;------------------------------------------------------------------------------ 
 
  (defun addNewBlock (name / ss e e1) 
    (xdrx_setmark) 
    (xdrx_polyline_make 
      '((0 0 0) (300 300 0) (-300 300 0) (0 0 0)) 
    ) 
 
    (xdrx_setpropertyvalue 
      (setq e (xdrx_AttributeDef_make 
                (xdrx_text_make '(0 400.0 0.0) "ELE_symbol" 300 0) 
                t 
              ) 
 
      ) 
      "textstring" 
      "%%p0.000" 
    ) 
    (xdrx_text_setproperty 
      e 
      "AlignPoint" 
      '(0 
        400.0 
        0.0 
       ) 
      "HozMode" 
      1 
      "VerMode" 
      0 
      "WidthFactor" 
      0.7 
    ) 
    (setq ss (xdrx_getss)) 
    (xdrx_block_make name ss '(0 0 0)) 
    (xdrx_object_delete ss) 
  ) 
 
 
;;;---callback function------------------------------------------------------------ 
;;;-------------------------------------------------------------------------------- 
 
 
  (vl-acad-defun 'dragtext) 
  (defun dragtext (p) 
    (setq p1   (xdrx_curve_getclosestpoint curve p) 
          f1   (xdrx_curve_getfirstderiv 
                 curve 
                 (xdrx_curve_getparamatpoint curve p1) 
               ) 
          dist (zgx-getdistoncurve 
                 curve 
                 p1 
                 startp 
               ) 
          an 
               (xdrx_vector_angle f1) 
          an 
               (xd::geom:angleformat an) 
    ) 
;;;---Using vl functions---------------------------------------------------------- 
 
    (setq e1 (vlax-ename->vla-object e)) 
    (xdrx_text_setstring 
      (car (xdrx_insert_getattribs e)) 
      (rtos (+ startEle (* dist slope 1e-3)) 2 3) 
    ) 
    (vla-put-rotation e1 (+ (* kk 0.5 pi) an)) 
    (vla-put-InsertionPoint e1 (vlax-3d-point p1)) 
 
  ) 
;;;--------------------------------------------------------------------------------- 
;;;---此处也可改为xdrx_curve_对应的函数，因为API已经调整，支持对spline取得距离 
  (defun zgx-getdistoncurve (e pt1 pt2 / rtn) 
    (abs (setq rtn (- 
                     (vlax-curve-getdistatpoint e pt2) 
                     (vlax-curve-getdistatpoint e pt1) 
                   ) 
         ) 
    ) 
  ) 
;;;---end of dragtext ,main program starts----------------------------------------- 
  (xdrx_begin) 
  (if (not (tblsearch "block" "$ele_symbol")) 
    (ADDNEWBLOCK "$ele_symbol") 
  ) 
;;;---此处加判断cad版本，是因为在cad2010下如果不关闭捕捉---------------- 
;;;---会出现崩溃情况-------------------------------------------------------------------- 
  (if (member (XD::Doc:AppVer) '(19)) 
    (setq osmodeValue 703) 
    (setq osmodeValue 0) 
  ) 
  (xdrx_sysvar_push 
    '("orthomode" 0) 
    '("autosnap" 55) 
    (list "osmode" osmodeValue) 
  ) 
  (and (setq e0 (entsel "\n在起点附件选取曲线:")) 
       (setq curve (car e0)) 
       (setq p1 (cadr e0)) 
       (setq lth (xdrx_curve_getdistatparam 
                   curve 
                   (xdrx_curve_getendparam curve) 
                 ) 
       ) 
  ) 
  (setq        startp (if (< (setq pa 
                             (xdrx_curve_getparamatpoint 
                               curve 
                               p1 
                             ) 
                      ) 
                      (* 0.5 (vlax-curve-getendparam curve)) 
                   ) 
                 (vlax-curve-getStartPoint curve) 
                 (vlax-curve-getendPoint curve) 
               ) 
  ) 
  (setq        loop t 
        kk 0 
  ) 
;;;--------------------------------------------------------------------------------- 
  (dcl-form-show rd_ele/form1) 
  (dcl-form-setpos 
    rd_ele/form1 
    (car (last (xdrx_document_pixelbox))) 
    (cadr (last (xdrx_document_pixelbox))) 
  ) 
  (if (setq 
        dwgScale (vlax-ldata-get "tcc_dwg_setting" "dwg_scale") 
      ) 
    (dcl-control-settext 
      rd_ele/form1/textbox3 
      (rtos dwgscale 2 0) 
    ) 
    (progn 
      (dcl-control-settext rd_ele/form1/textbox3 "100") 
      (setq dwgScale "100") 
      (vlax-ldata-put "tcc_dwg_setting" "dwg_scale" dwgScale) 
    ) 
  ) 
  (dcl-control-setkeepfocus rd_ele/form1 nil) 
  (setq firsttime t) 
  (while loop 
    (setq slope           (atof (dcl-control-gettext rd_ele/form1/textbox1)) 
          startEle (atof (dcl-control-gettext rd_ele/form1/textbox2)) 
          dwgScale (atof (dcl-control-gettext rd_ele/form1/textbox3)) 
    ) 
    (vlax-ldata-put "tcc_dwg_setting" "dwg_scale" dwgScale) 
    (xdrx_initget "s a d f") 
    (setq e (xdrx_insert_make "$ele_symbol" p1 (/ dwgScale 100.0) 0)) 
    (if        firsttime 
      (setq oldE e) 
    ) 
    (setq rtn 
           (xdrx_drag_jig 
             "dragtext" 
             "\n选择标注位置[设上一点为新起点标高(S)/旋转(A)/重新选点(D)/图取标高值(F)<退出>]" 
             "s a d f" 
             (+ 2 128) 
             0 
             p1 
           ) 
    ) 
    (cond 
      ((equal (type rtn) 'list) 
       (progn (setq loop t) 
              (progn (setq firsttime nil) (setq oldE (entlast))) 
       ) 
      ) 
      ((eq rtn -1) 
       (progn (setq loop nil) 
              (if e 
                (entdel e) 
              ) 
              (if (dcl-form-isactive rd_ele/form1) 
                (dcl-form-close rd_ele/form1) 
              ) 
       ) 
      ) 
      ((eq (strcase rtn) "D") 
       (progn 
         (if e 
           (entdel e) 
         ) 
         (xdrx_initget) 
         (setq startp (getpoint "\n选择新的起点")) 
       ) 
      ) 
      ((eq (strcase rtn) "S") 
       (progn 
         (if (not firsttime) 
           (progn 
             (dcl-control-settext 
               rd_ele/form1/textbox2 
               (xdrx_text_string (car (xdrx_insert_getattribs oldE))) 
             ) 
             (setq startp (xdrx_getpropertyvalue oldE "position")) 
           ) 
 
         ) 
         (if e 
           (entdel e) 
         ) 
       ) 
      ) 
      ((equal (strcase rtn) "A") 
       (progn (setq loop t) 
              (if (< kk 3) 
                (setq kk (1+ kk)) 
                (setq kk 0) 
              ) 
              (entdel (entlast)) 
       ) 
      ) 
      ((equal (strcase rtn) "F") 
       (progn (setq loop t) 
              (if (setq newEleValue (car (entsel "\n图取标高:"))) 
                (dcl-control-settext 
                  rd_ele/form1/textbox2 
                  (xdrx_getpropertyvalue 
                    (car (xdrx_insert_getattribs newEleValue)) 
                    "textstring" 
                  ) 
                ) 
              ) 
              (entdel (entlast)) 
       ) 
      )                                        ;eq q 
      ((eq (type rtn) 'str) 
       (xdrx_initget) 
      ) 
    ) 
  ) 
  (if (equal -4 rtn) 
    (progn 
      (if (dcl-form-isactive rd_ele/form1) 
        (dcl-form-close rd_ele/form1) 
      ) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_end) 
)

tanwei1 · 发表于 2017-8-27 11:32:41

下载运行提示错误

tanwei1 · 发表于 2017-8-27 11:57:44

请问楼主我下载插件后运行提示错误，请看看怎回事啊，谢谢

brainstorm · 发表于 2017-8-27 13:39:24

tanwei1 发表于 2017-8-27 11:57

1楼帖子有rd_ele.odcl文件，放到支持文件搜索目录下

tanwei1 · 发表于 2017-8-27 14:03:34

brainstorm 发表于 2017-8-27 13:39

下载了那个文件，问题依旧，能否发个完整的打包文件，谢谢

brainstorm · 发表于 2017-8-27 14:49:00

tanwei1 发表于 2017-8-27 14:03

1 需要安装opendcl
2 需要把附件文件放到cad支持文件目录下

请点击此处下载

查看状态：需购买或无权限

您的用户组是：游客

文件名称:odcl.rar
下载次数:71 文件大小:3.31 KB
下载权限: 不限以上 [免费赚D豆]

tanwei1 · 发表于 2017-8-27 17:57:36

brainstorm 发表于 2017-8-27 14:49

OpenDCL Studio 已安装，新插件也下载，加载后出现如下提示，请问怎么处理，谢谢！ PLTY)CKX0E%UJD2(45(JSQW.png

brainstorm · 发表于 2017-8-27 20:24:40

是放在cad 支持文件搜索目录下了么按理说不会我这里都没问题

newer · 发表于 2017-8-27 20:35:51

tanwei1 发表于 2017-8-27 17:57

你的OPENDCL版本是不是很久以前的？启动时候看看OPENDCL加载提示的版本。

安装最新的OPENDCL，或者安装XDRX API 或者晓东工具箱的最新版。

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

[标注] 根据坡度动态标注标高