设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

楼主: brainstorm

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

[复制链接]

签到天数: 374 天

连续签到: 3 天

[LV.9]以坛为家II

已领礼包: 777个

财富等级: 财运亨通

发表于 2017-8-16 09:18:57 | 显示全部楼层
厉害了我的哥。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 133 天

连续签到: 1 天

[LV.7]常住居民III

已领礼包: 56个

财富等级: 招财进宝

 楼主| 发表于 2017-8-16 16:12:41 | 显示全部楼层
本帖最后由 brainstorm 于 2017-8-16 20:24 编辑

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

rotate.gif

请点击此处下载

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

您的用户组是:游客

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

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1894 天

连续签到: 73 天

[LV.Master]伴坛终老I

已领礼包: 5242个

财富等级: 富甲天下

发表于 2017-8-16 19:23:28 | 显示全部楼层
附件里的文件不对吧?lsp文件就是N版的例子,不是一楼的程序
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 133 天

连续签到: 1 天

[LV.7]常住居民III

已领礼包: 56个

财富等级: 招财进宝

 楼主| 发表于 2017-8-16 20:29:56 | 显示全部楼层

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

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

论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1077 天

连续签到: 38 天

[LV.10]以坛为家III

已领礼包: 40个

财富等级: 招财进宝

发表于 2017-8-16 22:04:26 | 显示全部楼层

设计对话框的时候,保持焦点别勾上。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 594 天

连续签到: 4 天

[LV.9]以坛为家II

已领礼包: 124个

财富等级: 日进斗金

发表于 2017-8-17 14:55:05 | 显示全部楼层
支持!!!!!!!!!!!!!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复

使用道具 举报

签到天数: 133 天

连续签到: 1 天

[LV.7]常住居民III

已领礼包: 56个

财富等级: 招财进宝

 楼主| 发表于 2017-8-21 17:03:03 | 显示全部楼层
本帖最后由 brainstorm 于 2017-8-21 17:05 编辑

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

  1. (defun c:dlbg (/               *error*               AN
  2.                CURVE               DIST               dwgScale
  3.                E               E0               E1
  4.                F1               LOOP               LTH
  5.                P1               PA               SLOPE
  6.                STARTELE               STARTP
  7.                c:RD_ele/form1#OnMouseEntered   rtn
  8.                zgx-getdistoncurve
  9.                c:RD_ele/form1#OnMouseMovedOff  oldE
  10.                oldP               firsttime       newEleValue
  11.                osmodeValue
  12.               )
  13.   (command "_opendcl")
  14. ;;;---odlc form ----------------------------------------------------------------
  15.   (if (not $projecAlreadyLoaded)
  16.     (progn
  17.       (dcl-project-load "rd_ele")
  18.       (setq $projecAlreadyLoaded t)
  19.     )
  20.   )
  21. ;;;---function of odcl events----------------------------------------------------

  22.   (defun c:RD_ele/form1#OnMouseEntered (/)
  23.     (dcl-control-setfocus RD_ele/form1)
  24.   )

  25.   (defun c:RD_ele/form1/Label4#OnClicked (/)
  26.     (if        (equal 0 (dcl-control-getvalue RD_ele/form1/checkbox1))
  27.       (dcl-control-setvalue RD_ele/form1/checkbox1 1)
  28.       (dcl-control-setvalue RD_ele/form1/checkbox1 0)
  29.     )
  30.   )

  31.   (defun c:RD_ele/form1#OnMouseMovedOff        (/)

  32.     (setq slope           (atof (dcl-control-gettext rd_ele/form1/textbox1))
  33.           startEle (atof (dcl-control-gettext rd_ele/form1/textbox2))
  34.           dwgScale (atof (dcl-control-gettext rd_ele/form1/textbox3))
  35.     )
  36.     (vlax-ldata-put "tcc_dwg_setting" "dwg_scale" dwgScale)
  37.     (princ "\nmove off the form")
  38.     (if        e
  39.       (progn (entdel e)
  40.              (setq
  41.                e (xdrx_insert_make "$ele_symbol" p1 (/ dwgScale 100.0) 0)
  42.              )
  43.       )
  44.     )
  45.     (xdrx_setenttodb e)
  46.     (dcl-control-setkeepfocus rd_ele/form1 nil)
  47.     (redraw)
  48.   )

  49. ;;;-error function---------------------------------------------------------------
  50. ;;;------------------------------------------------------------------------------
  51.   (defun *error* (msg)
  52.     (if        (dcl-form-isactive rd_ele/form1)
  53.       (dcl-form-close rd_ele/form1)
  54.     )
  55.     (if        e
  56.       (entdel e)
  57.     )
  58.     (xdrx_sysvar_pop)
  59.     (princ "\n 程序退出 ... ... ... ... ")
  60.     (princ)
  61.   )

  62. ;;;--Create a block function-----------------------------------------------------
  63. ;;;------------------------------------------------------------------------------

  64.   (defun addNewBlock (name / ss e e1)
  65.     (xdrx_setmark)
  66.     (xdrx_polyline_make
  67.       '((0 0 0) (300 300 0) (-300 300 0) (0 0 0))
  68.     )

  69.     (xdrx_setpropertyvalue
  70.       (setq e (xdrx_AttributeDef_make
  71.                 (xdrx_text_make '(0 400.0 0.0) "ELE_symbol" 300 0)
  72.                 t
  73.               )

  74.       )
  75.       "textstring"
  76.       "%%p0.000"
  77.     )
  78.     (xdrx_text_setproperty
  79.       e
  80.       "AlignPoint"
  81.       '(0
  82.         400.0
  83.         0.0
  84.        )
  85.       "HozMode"
  86.       1
  87.       "VerMode"
  88.       0
  89.       "WidthFactor"
  90.       0.7
  91.     )
  92.     (setq ss (xdrx_getss))
  93.     (xdrx_block_make name ss '(0 0 0))
  94.     (xdrx_object_delete ss)
  95.   )


  96. ;;;---callback function------------------------------------------------------------
  97. ;;;--------------------------------------------------------------------------------


  98.   (vl-acad-defun 'dragtext)
  99.   (defun dragtext (p)
  100.     (setq p1   (xdrx_curve_getclosestpoint curve p)
  101.           f1   (xdrx_curve_getfirstderiv
  102.                  curve
  103.                  (xdrx_curve_getparamatpoint curve p1)
  104.                )
  105.           dist (zgx-getdistoncurve
  106.                  curve
  107.                  p1
  108.                  startp
  109.                )
  110.           an
  111.                (xdrx_vector_angle f1)
  112.           an
  113.                (xd::geom:angleformat an)
  114.     )
  115. ;;;---Using vl functions----------------------------------------------------------

  116.     (setq e1 (vlax-ename->vla-object e))
  117.     (xdrx_text_setstring
  118.       (car (xdrx_insert_getattribs e))
  119.       (rtos (+ startEle (* dist slope 1e-3)) 2 3)
  120.     )
  121.     (vla-put-rotation e1 (+ (* kk 0.5 pi) an))
  122.     (vla-put-InsertionPoint e1 (vlax-3d-point p1))

  123.   )
  124. ;;;---------------------------------------------------------------------------------
  125. ;;;---此处也可改为xdrx_curve_对应的函数,因为API已经调整,支持对spline取得距离
  126.   (defun zgx-getdistoncurve (e pt1 pt2 / rtn)
  127.     (abs (setq rtn (-
  128.                      (vlax-curve-getdistatpoint e pt2)
  129.                      (vlax-curve-getdistatpoint e pt1)
  130.                    )
  131.          )
  132.     )
  133.   )
  134. ;;;---end of dragtext ,main program starts-----------------------------------------
  135.   (xdrx_begin)
  136.   (if (not (tblsearch "block" "$ele_symbol"))
  137.     (ADDNEWBLOCK "$ele_symbol")
  138.   )
  139. ;;;---此处加判断cad版本,是因为在cad2010下如果不关闭捕捉----------------
  140. ;;;---会出现崩溃情况--------------------------------------------------------------------
  141.   (if (member (XD::Doc:AppVer) '(19))
  142.     (setq osmodeValue 703)
  143.     (setq osmodeValue 0)
  144.   )
  145.   (xdrx_sysvar_push
  146.     '("orthomode" 0)
  147.     '("autosnap" 55)
  148.     (list "osmode" osmodeValue)
  149.   )
  150.   (and (setq e0 (entsel "\n在起点附件选取曲线:"))
  151.        (setq curve (car e0))
  152.        (setq p1 (cadr e0))
  153.        (setq lth (xdrx_curve_getdistatparam
  154.                    curve
  155.                    (xdrx_curve_getendparam curve)
  156.                  )
  157.        )
  158.   )
  159.   (setq        startp (if (< (setq pa
  160.                              (xdrx_curve_getparamatpoint
  161.                                curve
  162.                                p1
  163.                              )
  164.                       )
  165.                       (* 0.5 (vlax-curve-getendparam curve))
  166.                    )
  167.                  (vlax-curve-getStartPoint curve)
  168.                  (vlax-curve-getendPoint curve)
  169.                )
  170.   )
  171.   (setq        loop t
  172.         kk 0
  173.   )
  174. ;;;---------------------------------------------------------------------------------
  175.   (dcl-form-show rd_ele/form1)
  176.   (dcl-form-setpos
  177.     rd_ele/form1
  178.     (car (last (xdrx_document_pixelbox)))
  179.     (cadr (last (xdrx_document_pixelbox)))
  180.   )
  181.   (if (setq
  182.         dwgScale (vlax-ldata-get "tcc_dwg_setting" "dwg_scale")
  183.       )
  184.     (dcl-control-settext
  185.       rd_ele/form1/textbox3
  186.       (rtos dwgscale 2 0)
  187.     )
  188.     (progn
  189.       (dcl-control-settext rd_ele/form1/textbox3 "100")
  190.       (setq dwgScale "100")
  191.       (vlax-ldata-put "tcc_dwg_setting" "dwg_scale" dwgScale)
  192.     )
  193.   )
  194.   (dcl-control-setkeepfocus rd_ele/form1 nil)
  195.   (setq firsttime t)
  196.   (while loop
  197.     (setq slope           (atof (dcl-control-gettext rd_ele/form1/textbox1))
  198.           startEle (atof (dcl-control-gettext rd_ele/form1/textbox2))
  199.           dwgScale (atof (dcl-control-gettext rd_ele/form1/textbox3))
  200.     )
  201.     (vlax-ldata-put "tcc_dwg_setting" "dwg_scale" dwgScale)
  202.     (xdrx_initget "s a d f")
  203.     (setq e (xdrx_insert_make "$ele_symbol" p1 (/ dwgScale 100.0) 0))
  204.     (if        firsttime
  205.       (setq oldE e)
  206.     )
  207.     (setq rtn
  208.            (xdrx_drag_jig
  209.              "dragtext"
  210.              "\n选择标注位置[设上一点为新起点标高(S)/旋转(A)/重新选点(D)/图取标高值(F)<退出>]"
  211.              "s a d f"
  212.              (+ 2 128)
  213.              0
  214.              p1
  215.            )
  216.     )
  217.     (cond
  218.       ((equal (type rtn) 'list)
  219.        (progn (setq loop t)
  220.               (progn (setq firsttime nil) (setq oldE (entlast)))
  221.        )
  222.       )
  223.       ((eq rtn -1)
  224.        (progn (setq loop nil)
  225.               (if e
  226.                 (entdel e)
  227.               )
  228.               (if (dcl-form-isactive rd_ele/form1)
  229.                 (dcl-form-close rd_ele/form1)
  230.               )
  231.        )
  232.       )
  233.       ((eq (strcase rtn) "D")
  234.        (progn
  235.          (if e
  236.            (entdel e)
  237.          )
  238.          (xdrx_initget)
  239.          (setq startp (getpoint "\n选择新的起点"))
  240.        )
  241.       )
  242.       ((eq (strcase rtn) "S")
  243.        (progn
  244.          (if (not firsttime)
  245.            (progn
  246.              (dcl-control-settext
  247.                rd_ele/form1/textbox2
  248.                (xdrx_text_string (car (xdrx_insert_getattribs oldE)))
  249.              )
  250.              (setq startp (xdrx_getpropertyvalue oldE "position"))
  251.            )

  252.          )
  253.          (if e
  254.            (entdel e)
  255.          )
  256.        )
  257.       )
  258.       ((equal (strcase rtn) "A")
  259.        (progn (setq loop t)
  260.               (if (< kk 3)
  261.                 (setq kk (1+ kk))
  262.                 (setq kk 0)
  263.               )
  264.               (entdel (entlast))
  265.        )
  266.       )
  267.       ((equal (strcase rtn) "F")
  268.        (progn (setq loop t)
  269.               (if (setq newEleValue (car (entsel "\n图取标高:")))
  270.                 (dcl-control-settext
  271.                   rd_ele/form1/textbox2
  272.                   (xdrx_getpropertyvalue
  273.                     (car (xdrx_insert_getattribs newEleValue))
  274.                     "textstring"
  275.                   )
  276.                 )
  277.               )
  278.               (entdel (entlast))
  279.        )
  280.       )                                        ;eq q
  281.       ((eq (type rtn) 'str)
  282.        (xdrx_initget)
  283.       )
  284.     )
  285.   )
  286.   (if (equal -4 rtn)
  287.     (progn
  288.       (if (dcl-form-isactive rd_ele/form1)
  289.         (dcl-form-close rd_ele/form1)
  290.       )
  291.     )
  292.   )
  293.   (xdrx_sysvar_pop)
  294.   (xdrx_end)
  295. )



论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 4 天

连续签到: 1 天

[LV.2]偶尔看看I

已领礼包: 4个

财富等级: 恭喜发财

发表于 2017-8-27 11:32:41 | 显示全部楼层
下载运行提示错误
Y1R7ERU19JU~YK@UPRKQLTC.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 4 天

连续签到: 1 天

[LV.2]偶尔看看I

已领礼包: 4个

财富等级: 恭喜发财

发表于 2017-8-27 11:57:44 | 显示全部楼层
请问楼主我下载插件后运行提示错误,请看看怎回事啊,谢谢
Y1R7ERU19JU~YK@UPRKQLTC.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 133 天

连续签到: 1 天

[LV.7]常住居民III

已领礼包: 56个

财富等级: 招财进宝

 楼主| 发表于 2017-8-27 13:39:24 | 显示全部楼层

1楼帖子有rd_ele.odcl文件,放到支持文件搜索目录下
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 4 天

连续签到: 1 天

[LV.2]偶尔看看I

已领礼包: 4个

财富等级: 恭喜发财

发表于 2017-8-27 14:03:34 | 显示全部楼层

下载了那个文件,问题依旧,能否发个完整的打包文件,谢谢
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 133 天

连续签到: 1 天

[LV.7]常住居民III

已领礼包: 56个

财富等级: 招财进宝

 楼主| 发表于 2017-8-27 14:49:00 | 显示全部楼层

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

请点击此处下载

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

您的用户组是:游客

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


论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 4 天

连续签到: 1 天

[LV.2]偶尔看看I

已领礼包: 4个

财富等级: 恭喜发财

发表于 2017-8-27 17:57:36 | 显示全部楼层

OpenDCL Studio 已安装,新插件也下载,加载后出现如下提示,请问怎么处理,谢谢! PLTY)CKX0E%UJD2(45(JSQW.png
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 133 天

连续签到: 1 天

[LV.7]常住居民III

已领礼包: 56个

财富等级: 招财进宝

 楼主| 发表于 2017-8-27 20:24:40 来自手机 | 显示全部楼层
是放在cad 支持文件搜索目录下了么 按理说不会 我这里都没问题
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

签到天数: 1077 天

连续签到: 38 天

[LV.10]以坛为家III

已领礼包: 40个

财富等级: 招财进宝

发表于 2017-8-27 20:35:51 | 显示全部楼层

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

安装最新的OPENDCL,或者安装XDRX API 或者晓东工具箱的最新版。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|小黑屋|手机版|Archiver|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )  

GMT+8, 2018-8-15 21:30 , Processed in 0.250377 second(s), 63 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表