根据坡度动态标注标高

brainstorm · 发表于 2017-8-15 12:21:51

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

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

×

本帖最后由 newer 于 2017-8-15 17:33 编辑

因为下午出差，很多地方还未完善，如鼠标离开对话框事件，出图比例变化会多产生一个标高等；
交互上的细节都没仔细考虑，支持变坡度分段标注没有完善,即每次以上一点作为计算基点，实时读取对话框数据;应该用动态块做标高符号，这样可以选择多种形式的标高符号。

关于说对话框需要密码，我也搞不清楚。我上传了一个odcl文件，把(dcl-project-import .....)删除，替换
为(dcl-project-load "rd_ele")试试。

先发一个看看。
部分API函数没用明白，就用vl的代替了,求大师指点
代码注释采用英文是因为我一粘贴就乱码，同样拷贝论坛的中文也乱码，如何解决？

(defun c:tt (/ *error* AN CURVE DIST DWGSCALLE E E0 E1 F1 LOOP LTH P1
PA PA0 SLOPE STARTELE STARTP
)
(command "_opendcl")
;;;---odlc form ----------------------------------------------------------------
(dcl-Project-Import
'("YWt6A7gYAACtuG11BuKT5rUxLT9quME8JVjaVO7mxi79f10v/+jp03UdcmTdXvw4ImbbLu62td58"
"D18lbVoP2/fEDhsihjICOunEr+N1aVKCfTJqp2f9NENNPpmgUTYt3jqtIAyR46Gyok2ZsEOh4t97"
"j+dGmDABdZQPeOOW6619nj1g7tF1rCZkP0v8DKjedMWaIFDbFDra1VD7L/XW6tyW7igjdDcTcxzW"
"7WBfl2drlOytcmipaD0saejk9kIlVakMz2LtxPbPJlnd+/O7MN9wV8u1S1TIPCwte5MxMlL47vn+"
"DyxwHl3qeUfmRRpmoX9yHm4DrC/DPa8CtSJpq3yRAutI3Dizs2Lhu970vUGh0kMp6feRboFYYFwA"
"fWFi+VTMnQsVgDqD+fcNQyCpjVGTjfjhbcFeADgCsxsBDXkIvWd4686tKfxYit0vhmxQNuVQc7dD"
"WIsjjNkQxBITNLuoAN/1DGFKiKoxBJVvHMG5s8GWVejGPL7lqUMPFZw0I/UsiqIFKUHWTEVFiZty"
"lqD7eIkOItednJT2RsMxIBw6/A/flrT/NLIKW4dmggWaM5W2jaQ2T5MzyCNlKzGe8PrZGlHh5l3R"
"7sahiwT/OGI9z+KjmJWLNMcg0BnfICVBWMvhH4y9b69lSqFeQQiuxpUTgf3k8SQQrcLtXMjiBkXz"
"gejG55gT9ZVDDT3MsHrfVBLRYd2slXU7uCiMjPabHLP5t9V4nDicPbpvjORdDWWz3F0sMRSILxpB"
"WrtCXCA1ouXOEZLUYJzAugbgkYTVcS6FR5wIzAHrxuvG7QbyhkiPV5y3ugKzjPKLubKpSYyR1dpz"
"WemsjS2IAzMF6QXC/pAjHsb8KXgB/drXCF3lmtV8mWVR1/0rkQnREq2zTVlAiPJLUwVLJtSEJ5P1"
"1qWGkS6JI8arF4yhFJVQe+P7S3lWkCYJ8e/kcGHaJ/nS3UqVuhqyC/jtG7LUq7LmGyan8uf18rPm"
"4KrM2+cH+RSJXOVTTUwl0E/CJsgywFza7lMzoi/IYmABCyCBUe53p0xTxLUYteuz6MRLHgZPI1KC"
"tbtsCx9MeJecpovXjxaVw63n3nWNwj1pE7aUnOGt+2ATSJ7tk1ztFR17Ce84RacjmlJREWmXdbTs"
"2QEH1zMXSedoixgJ7YGrECxhAX70BqnK"
)
)
;;;---function of odcl events----------------------------------------------------
(defun c:RD_ele/form1#OnMouseEntered (/)
(dcl-control-setfocus RD_ele/form1)
)
(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))
dwgScalle (atof (dcl-control-gettext rd_ele/form1/textbox3))
)
(dcl-control-setkeepfocus RD_ele/form1 nil)
)
;;;-error function---------------------------------------------------------------
;;;------------------------------------------------------------------------------
(defun *error* (msg)
(if (dcl-form-isactive rd_ele/form1)
(dcl-form-close rd_ele/form1)
)
(entdel (entlast))
(xdrx_pointmonitor)
(xdrx_sysvar_pop)
(princ "\n canceled ... ... ... ... ")
(princ)
)
(vl-acad-defun 'dragtext)
;;;--Create a block function-----------------------------------------------------
;;;------------------------------------------------------------------------------
(defun addNewBlock (name / ss n)
(xdrx_setmark
(xdrx_polyline_make
'((0 0 0) (300 300 0) (-300 300 0) (0 0 0))
)
)
(entdel (entlast))
(xdrx_polyline_make
'((0 0 0) (300 300 0) (-300 300 0) (0 0 0))
)
(xdrx_setpropertyvalue
(xdrx_AttributeDef_make
(xdrx_text_make '(-580.0 400.0 0.0) "ELE_symbol" 300 0)
t
)
"textstring"
"%%p0.000"
)
(setq ss (xdrx_getss))
(xdrx_block_make name ss '(0 0 0))
(setq n -1)
(repeat (sslength ss) (entdel (ssname ss (setq n (1+ n)))))
)
;;;---callback function------------------------------------------------------------
;;;--------------------------------------------------------------------------------
(defun dragtext (p)
(setq p1 (xdrx_curve_getclosestpoint curve p))
(if (not (equal lastpoint p1 1e-3))
(progn (setq f1 (xdrx_curve_getfirstderiv curve p1)
dist (xdrx_curve_getdistatpoint curve p1)
s_dir (xdrx_entity_direction e)
s_ori (xdrx_getpropertyvalue e "position")
an1 (xdrx_vector_angle s_dir)
an2 (xdrx_vector_angle f1)
)
(if (and (> an1 (/ pi 2.0)) (< an1 (* 3 (/ pi 2.0))))
(setq s_dir (xdrx_vector_negate s_dir))
)
(if (and (> an2 (/ pi 2.0)) (< an2 (* 3 (/ pi 2.0))))
(setq f1 (xdrx_vector_negate f1))
)
(xdrx_entity_align
e
s_ori
(mapcar '+ s_ori s_dir)
p1
(mapcar '+ p1 f1)
)
(xdrx_setpropertyvalue
att
"textstring"
(rtos (+ startEle (* dist slope 1e-3)) 2 3)
)
)
)
(setq lastpoint p1)
)
;;;---end of dragtext ,main program starts-----------------------------------------
(xdrx_begin)
(if (not (tblsearch "block" "$ele_symbol"))
(ADDNEWBLOCK "$ele_symbol")
)
(xdrx_sysvar_push '("orthomode" 0) '("autosnap" 55) '("dimzin" 0))
(and (setq e0 (xdrx_entsel
"\n拾取曲线<退出>:"
'((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))
)
)
(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 (xdrx_curve_getendparam curve))
)
t
nil
)
)
(setq loop t)
;;;-------------------------------------------------------------------------------
(dcl-form-show rd_ele/form1)
(while loop
(setq slope (atof (dcl-control-gettext rd_ele/form1/textbox1))
startEle (atof (dcl-control-gettext rd_ele/form1/textbox2))
dwgScalle (atof (dcl-control-gettext rd_ele/form1/textbox3))
)
(setq e (xdrx_insert_make "$ele_symbol" '(-100000.0 -100000.0 0) (/ dwgScalle 100) 0)
att (car (xdrx_getpropertyvalue e "AttributeEntities"))
)
(xdrx_pointmonitor "dragtext")
(if (not (getpoint "\n确定标高插入位置<结束>:"))
(progn (entdel (entlast))
(xdrx_pointmonitor)
(setq loop nil)
(if (dcl-form-isactive rd_ele/form1)
(dcl-form-close rd_ele/form1)
)
)
)
)
(xdrx_sysvar_pop)
(xdrx_end)
(princ)
)

(defun c:tt (/             *error* AN             CURVE   DIST    DWGSCALLE             E             E0             E1             F1             LOOP    LTH     P1 
             PA             PA0     SLOPE   STARTELE             STARTP 
            ) 
  (command "_opendcl") 
;;;---odlc form ---------------------------------------------------------------- 
  (dcl-Project-Import 
    '("YWt6A7gYAACtuG11BuKT5rUxLT9quME8JVjaVO7mxi79f10v/+jp03UdcmTdXvw4ImbbLu62td58" 
      "D18lbVoP2/fEDhsihjICOunEr+N1aVKCfTJqp2f9NENNPpmgUTYt3jqtIAyR46Gyok2ZsEOh4t97" 
      "j+dGmDABdZQPeOOW6619nj1g7tF1rCZkP0v8DKjedMWaIFDbFDra1VD7L/XW6tyW7igjdDcTcxzW" 
      "7WBfl2drlOytcmipaD0saejk9kIlVakMz2LtxPbPJlnd+/O7MN9wV8u1S1TIPCwte5MxMlL47vn+" 
      "DyxwHl3qeUfmRRpmoX9yHm4DrC/DPa8CtSJpq3yRAutI3Dizs2Lhu970vUGh0kMp6feRboFYYFwA" 
      "fWFi+VTMnQsVgDqD+fcNQyCpjVGTjfjhbcFeADgCsxsBDXkIvWd4686tKfxYit0vhmxQNuVQc7dD" 
      "WIsjjNkQxBITNLuoAN/1DGFKiKoxBJVvHMG5s8GWVejGPL7lqUMPFZw0I/UsiqIFKUHWTEVFiZty" 
      "lqD7eIkOItednJT2RsMxIBw6/A/flrT/NLIKW4dmggWaM5W2jaQ2T5MzyCNlKzGe8PrZGlHh5l3R" 
      "7sahiwT/OGI9z+KjmJWLNMcg0BnfICVBWMvhH4y9b69lSqFeQQiuxpUTgf3k8SQQrcLtXMjiBkXz" 
      "gejG55gT9ZVDDT3MsHrfVBLRYd2slXU7uCiMjPabHLP5t9V4nDicPbpvjORdDWWz3F0sMRSILxpB" 
      "WrtCXCA1ouXOEZLUYJzAugbgkYTVcS6FR5wIzAHrxuvG7QbyhkiPV5y3ugKzjPKLubKpSYyR1dpz" 
      "WemsjS2IAzMF6QXC/pAjHsb8KXgB/drXCF3lmtV8mWVR1/0rkQnREq2zTVlAiPJLUwVLJtSEJ5P1" 
      "1qWGkS6JI8arF4yhFJVQe+P7S3lWkCYJ8e/kcGHaJ/nS3UqVuhqyC/jtG7LUq7LmGyan8uf18rPm" 
      "4KrM2+cH+RSJXOVTTUwl0E/CJsgywFza7lMzoi/IYmABCyCBUe53p0xTxLUYteuz6MRLHgZPI1KC" 
      "tbtsCx9MeJecpovXjxaVw63n3nWNwj1pE7aUnOGt+2ATSJ7tk1ztFR17Ce84RacjmlJREWmXdbTs" 
      "2QEH1zMXSedoixgJ7YGrECxhAX70BqnK" 
     ) 
  ) 
;;;---function of odcl events---------------------------------------------------- 
  (defun c:RD_ele/form1#OnMouseEntered (/) 
    (dcl-control-setfocus RD_ele/form1) 
  ) 
  (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)) 
          dwgScalle (atof (dcl-control-gettext rd_ele/form1/textbox3)) 
    ) 
    (dcl-control-setkeepfocus RD_ele/form1 nil) 
  ) 
;;;-error function--------------------------------------------------------------- 
;;;------------------------------------------------------------------------------ 
  (defun *error* (msg) 
    (if        (dcl-form-isactive rd_ele/form1) 
      (dcl-form-close rd_ele/form1) 
    ) 
    (entdel (entlast)) 
    (xdrx_pointmonitor) 
    (xdrx_sysvar_pop) 
    (princ "\n canceled ... ... ... ... ") 
    (princ) 
  ) 
  (vl-acad-defun 'dragtext) 
;;;--Create a block function----------------------------------------------------- 
;;;------------------------------------------------------------------------------ 
  (defun addNewBlock (name / ss n) 
    (xdrx_setmark 
      (xdrx_polyline_make 
        '((0 0 0) (300 300 0) (-300 300 0) (0 0 0)) 
      ) 
    ) 
    (entdel (entlast)) 
    (xdrx_polyline_make 
      '((0 0 0) (300 300 0) (-300 300 0) (0 0 0)) 
    ) 
    (xdrx_setpropertyvalue 
      (xdrx_AttributeDef_make 
        (xdrx_text_make '(-580.0 400.0 0.0) "ELE_symbol" 300 0) 
        t 
      ) 
      "textstring" 
      "%%p0.000" 
    ) 
    (setq ss (xdrx_getss)) 
    (xdrx_block_make name ss '(0 0 0)) 
    (setq n -1) 
    (repeat (sslength ss) (entdel (ssname ss (setq n (1+ n))))) 
  ) 
;;;---callback function------------------------------------------------------------ 
;;;-------------------------------------------------------------------------------- 
  (defun dragtext (p) 
    (setq p1 (xdrx_curve_getclosestpoint curve p)) 
    (if        (not (equal lastpoint p1 1e-3)) 
      (progn (setq f1         (xdrx_curve_getfirstderiv curve p1) 
                   dist         (xdrx_curve_getdistatpoint curve p1) 
                   s_dir (xdrx_entity_direction e) 
                   s_ori (xdrx_getpropertyvalue e "position") 
                   an1         (xdrx_vector_angle s_dir) 
                   an2         (xdrx_vector_angle f1) 
             ) 
             (if (and (> an1 (/ pi 2.0)) (< an1 (* 3 (/ pi 2.0)))) 
               (setq s_dir (xdrx_vector_negate s_dir)) 
             ) 
             (if (and (> an2 (/ pi 2.0)) (< an2 (* 3 (/ pi 2.0)))) 
               (setq f1 (xdrx_vector_negate f1)) 
             ) 
             (xdrx_entity_align 
               e 
               s_ori 
               (mapcar '+ s_ori s_dir) 
               p1 
               (mapcar '+ p1 f1) 
             ) 
             (xdrx_setpropertyvalue 
               att 
               "textstring" 
               (rtos (+ startEle (* dist slope 1e-3)) 2 3) 
             ) 
      ) 
    ) 
    (setq lastpoint p1) 
  ) 
;;;---end of dragtext ,main program starts----------------------------------------- 
  (xdrx_begin) 
  (if (not (tblsearch "block" "$ele_symbol")) 
    (ADDNEWBLOCK "$ele_symbol") 
  ) 
  (xdrx_sysvar_push '("orthomode" 0) '("autosnap" 55) '("dimzin" 0)) 
  (and (setq e0        (xdrx_entsel 
                  "\n拾取曲线<退出>:" 
                  '((0 . "*LINE,ARC,CIRCLE,ELLIPSE")) 
                ) 
       ) 
       (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 (xdrx_curve_getendparam curve)) 
                   ) 
                 t 
                 nil 
               ) 
  ) 
  (setq loop t) 
;;;-------------------------------------------------------------------------------   
  (dcl-form-show rd_ele/form1) 
  (while loop 
    (setq slope            (atof (dcl-control-gettext rd_ele/form1/textbox1)) 
          startEle  (atof (dcl-control-gettext rd_ele/form1/textbox2)) 
          dwgScalle (atof (dcl-control-gettext rd_ele/form1/textbox3)) 
    ) 
    (setq e   (xdrx_insert_make "$ele_symbol" '(-100000.0 -100000.0 0) (/ dwgScalle 100) 0) 
          att (car (xdrx_getpropertyvalue e "AttributeEntities")) 
    ) 
    (xdrx_pointmonitor "dragtext") 
    (if        (not (getpoint "\n确定标高插入位置<结束>:")) 
      (progn (entdel (entlast)) 
             (xdrx_pointmonitor) 
             (setq loop nil) 
             (if (dcl-form-isactive rd_ele/form1) 
               (dcl-form-close rd_ele/form1) 
             ) 
      ) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_end) 
  (princ) 
)

newer · 发表于 2017-8-15 17:09:39

liuyj 发表于 2017-8-15 15:12

修改了一楼的代码，可以正常运行了。

newer · 发表于 2017-8-15 12:45:57

修改下对话框吧，要密码。

titanwuxj · 发表于 2017-8-15 13:21:30

很好的设想，学习了。

brainstorm · 发表于 2017-8-15 13:44:34

附件是odcl原文件，我没设密码啊
用xdrx_drag_jig拖动效果更好，因为忽略了对被拖动对象的自身捕捉，所以更流畅
代码：

(defun c:tt (/ *error* AN
CURVE DIST DWGSCALLE
E E0 E1
F1 LOOP LTH
P1 PA PA0
SLOPE STARTELE STARTP
c:RD_ele/form1#OnMouseEntered
c:RD_ele/form1#OnMouseMovedOff rtn
)
(command "_opendcl")
;;;---odlc form ----------------------------------------------------------------
(dcl-Project-Import
'("YWt6A7gYAACUsJuiBuKTJjMxLT9qQ3GkTL/UPhycPHN48jpTyrtcCx/yv7pWJn9dUPKML1Rvevx0"
"unMlbVoP2/fEDhsihueGbyPGvvOQIsYOn3FOLxoZclSLsMqOoEX3Smv1eESzyg2YsKIJoeMFkOPK"
"WkflOsSFJK7+LZY44Qp1vqVc3iZxOiYn+VC6z21v+i/5Vnw2dpDs5/7n0+sPfuNc9V5aXVN3NTE2"
"qd3esqjfXYvO2qjmPsM23KZb4c42fIwmw0kcSgj2Wlbd1racOB02yrkbM9MCigm6lvLedgATmlSW"
"yH+0PH+sM2CdMx5+PUZVNasxhqx8NeXfEGxgWALvDuyOebxd+tHHjrhQkvituUvOE9U+coMWbAJ/"
"mTrIIa4Hh2PsYPnEkqzKV2UzBEoSyroaK3y0GcfTgjAo8WwoyoBLtJiC5QjKFP8ZEDRh+2RNQdgD"
"6r0o7Y68ryrnU5Gvxq4MkQEYtbOEWfrhbAAyhnmnLZ90d7EalR6JtY+AT4u4S3ErG5XHXaPRIcKq"
"vkNiKZTWhgoqsBbhhgkqvC8HtzGJtvGJd9FfokkRyk88i2xARRHiiytFC/6aGXYJ7IA1+qV2CW1g"
"WQL9jne8LY2AN58npWANdiG2wLG8IlnQ2oOtiIVkB3xnnc5+FBA0qy5yegFh3U2k42BFOPNCGLXL"
"LIuuoBGYYO/AHLxijdv6hSOfmhE8VbTbiWY0ibfGP8AxPcPOk+asCKjtY3BQ06mGVKfP4+DFsCAB"
"Pp1dSBCpBnkPVz4GZUOBa58YjKUYqQVo+FoVed/UkyuhuBqrWRycaMyMzvO1S0A6KEtsEFwC7g7q"
"0pgyzuvClrZyuduFi5RsfdVHTYZk2wYL5B3q0p7Z1ptSj36nG/PFR7BksoQizUR99cfsBlbk59tA"
"CdjhF+BDiNAJQsgWiIBXJefjdc6vppEenVPGpxpUmyyNWnUgql0jT6lk5tcc+I1rDYcoslSCo/Qn"
"9mslT9OS1NuPwl11krsBLFMpZcYuy3KZ1Z**zVtWSpTOVjgcWiLwsHAbNQbMAbsE8uq1YN4ULr1"
"LuBpNbl17Z/3adMp2FlEpBDhInfCToVjwha5QcQ72HBKrVNM6sE7UKEl2p8cgGjnvPXFOwT9LByK"
"QVHv0hDtR7d49cIzlIh1+LiqXA=="
)
)
;;;---function of odcl events----------------------------------------------------
(defun c:RD_ele/form1#OnMouseEntered (/)
(dcl-control-setfocus RD_ele/form1)
)
(defun c:RD_ele/form1#OnMouseMovedOff (/)
(dcl-control-setkeepfocus RD_ele/form1 nil)
)
;;;-error function---------------------------------------------------------------
;;;------------------------------------------------------------------------------
(defun *error* (msg)
(if (dcl-form-isactive rd_ele/form1)
(dcl-form-close rd_ele/form1)
)
(entdel (entlast))
(xdrx_pointmonitor)
(xdrx_sysvar_pop)
(princ "\n canceled ... ... ... ... ")
(princ)
)
(vl-acad-defun 'dragtext)
;;;--Create a block function-----------------------------------------------------
;;;------------------------------------------------------------------------------
(defun addNewBlock (name / ss n)
(xdrx_setmark
(xdrx_polyline_make
'((0 0 0) (300 300 0) (-300 300 0) (0 0 0))
)
)
(entdel (entlast))
(xdrx_polyline_make
'((0 0 0) (300 300 0) (-300 300 0) (0 0 0))
)
(xdrx_setpropertyvalue
(xdrx_AttributeDef_make
(xdrx_text_make '(-580.0 400.0 0.0) "ELE_symbol" 300 0)
t
)
"textstring"
"%%p0.000"
)
(setq ss (xdrx_getss))
(xdrx_block_make name ss '(0 0 0))
(setq n -1)
(repeat (sslength ss)
(entdel (ssname ss (setq n (1+ n))))
)
)
;;;---callback function------------------------------------------------------------
;;;--------------------------------------------------------------------------------
(defun dragtext (p)
(setq p1 (vlax-curve-getclosestpointto curve p)
f1 (vlax-curve-getfirstderiv
curve
(vlax-curve-getparamatpoint curve p1)
)
pa0 (vlax-curve-getparamatpoint curve p1)
dist (if startp
(vlax-curve-getdistatparam curve pa0)
(- lth (vlax-curve-getdistatparam curve pa0))
)
an (xdrx_vector_angle f1)
an (xd::geom:angleformat an)
)
;;;---The spacing between text and polyline may change abnormally if using API-----
;;;---So using Vl functions instead------------------------------------------------
;;; (foreach n (xdrx_insert_getattribs e)
;;; (xdrx_setpropertyvalue
;;; n
;;; "textstring"
;;; (rtos dist 2 3)
;;; "rotation"
;;; an
;;; )
;;; )
;;; (xdrx_setpropertyvalue e "rotation" an)
;;; (vla-put-insertionpoint
;;; (vlax-ename->vla-object e)
;;; (vlax-3d-point p1)
;;; )
;;;---Using vl functions----------------------------------------------------------
(setq e1 (vlax-ename->vla-object e))
(foreach each (vlax-safearray->list
(vlax-variant-value (vla-GetAttributes e1))
)
(vla-put-textstring
each
(rtos (+ startEle (* dist slope 1e-3)) 2 3)
)
)
(vla-put-rotation e1 an)
(vla-put-InsertionPoint e1 (vlax-3d-point p1))
;;;--------------------------------------------------------------------------------
)
;;;---end of dragtext ,main program starts-----------------------------------------
(xdrx_begin)
(if (not (tblsearch "block" "$ele_symbol"))
(ADDNEWBLOCK "$ele_symbol")
)
(xdrx_sysvar_push '("orthomode" 0) '("autosnap" 55))
(and (setq e0 (entsel "\nselect insert"))
(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))
)
t
nil
)
)
(setq loop t)
;;;-------------------------------------------------------------------------------
(dcl-form-show rd_ele/form1)
(while loop
(setq slope (atof (dcl-control-gettext rd_ele/form1/textbox1))
startEle (atof (dcl-control-gettext rd_ele/form1/textbox2))
dwgScalle (atof (dcl-control-gettext rd_ele/form1/textbox3))
)
(xdrx_initget "s")
(setq e (xdrx_insert_make "$ele_symbol" p1 (/ dwgScalle 100) 0))
(xdrx_setenttodb e)
(if (and
(setq rtn
(xdrx_drag_jig
"dragtext"
"\nselect the position of text[exit(s)]"
"s"
(+ 128)
0
p1
)
)
(equal (type rtn) 'list)
)
(setq loop t)
(progn (setq loop nil)
(entdel (entlast))
(if (dcl-form-isactive rd_ele/form1)
(dcl-form-close rd_ele/form1)
)
)
)
)
(if (equal -4 rtn)
(progn
;;; (entdel (entlast))
(if (dcl-form-isactive rd_ele/form1)
(dcl-form-close rd_ele/form1)
)
)
)
(xdrx_sysvar_pop)
(xdrx_end)
)

(defun c:tt (/                     *error*             AN 
             CURVE             DIST             DWGSCALLE 
             E                     E0                     E1 
             F1                     LOOP             LTH 
             P1                     PA                     PA0 
             SLOPE             STARTELE             STARTP 
             c:RD_ele/form1#OnMouseEntered 
             c:RD_ele/form1#OnMouseMovedOff rtn 
            ) 
 
 
 
  (command "_opendcl") 
;;;---odlc form ---------------------------------------------------------------- 
  (dcl-Project-Import 
    '("YWt6A7gYAACUsJuiBuKTJjMxLT9qQ3GkTL/UPhycPHN48jpTyrtcCx/yv7pWJn9dUPKML1Rvevx0" 
      "unMlbVoP2/fEDhsihueGbyPGvvOQIsYOn3FOLxoZclSLsMqOoEX3Smv1eESzyg2YsKIJoeMFkOPK" 
      "WkflOsSFJK7+LZY44Qp1vqVc3iZxOiYn+VC6z21v+i/5Vnw2dpDs5/7n0+sPfuNc9V5aXVN3NTE2" 
      "qd3esqjfXYvO2qjmPsM23KZb4c42fIwmw0kcSgj2Wlbd1racOB02yrkbM9MCigm6lvLedgATmlSW" 
      "yH+0PH+sM2CdMx5+PUZVNasxhqx8NeXfEGxgWALvDuyOebxd+tHHjrhQkvituUvOE9U+coMWbAJ/" 
      "mTrIIa4Hh2PsYPnEkqzKV2UzBEoSyroaK3y0GcfTgjAo8WwoyoBLtJiC5QjKFP8ZEDRh+2RNQdgD" 
      "6r0o7Y68ryrnU5Gvxq4MkQEYtbOEWfrhbAAyhnmnLZ90d7EalR6JtY+AT4u4S3ErG5XHXaPRIcKq" 
      "vkNiKZTWhgoqsBbhhgkqvC8HtzGJtvGJd9FfokkRyk88i2xARRHiiytFC/6aGXYJ7IA1+qV2CW1g" 
      "WQL9jne8LY2AN58npWANdiG2wLG8IlnQ2oOtiIVkB3xnnc5+FBA0qy5yegFh3U2k42BFOPNCGLXL" 
      "LIuuoBGYYO/AHLxijdv6hSOfmhE8VbTbiWY0ibfGP8AxPcPOk+asCKjtY3BQ06mGVKfP4+DFsCAB" 
      "Pp1dSBCpBnkPVz4GZUOBa58YjKUYqQVo+FoVed/UkyuhuBqrWRycaMyMzvO1S0A6KEtsEFwC7g7q" 
      "0pgyzuvClrZyuduFi5RsfdVHTYZk2wYL5B3q0p7Z1ptSj36nG/PFR7BksoQizUR99cfsBlbk59tA" 
      "CdjhF+BDiNAJQsgWiIBXJefjdc6vppEenVPGpxpUmyyNWnUgql0jT6lk5tcc+I1rDYcoslSCo/Qn" 
      "9mslT9OS1NuPwl11krsBLFMpZcYuy3KZ1Z**zVtWSpTOVjgcWiLwsHAbNQbMAbsE8uq1YN4ULr1" 
      "LuBpNbl17Z/3adMp2FlEpBDhInfCToVjwha5QcQ72HBKrVNM6sE7UKEl2p8cgGjnvPXFOwT9LByK" 
      "QVHv0hDtR7d49cIzlIh1+LiqXA==" 
     ) 
  ) 
 
;;;---function of odcl events---------------------------------------------------- 
 
  (defun c:RD_ele/form1#OnMouseEntered (/) 
    (dcl-control-setfocus RD_ele/form1) 
  ) 
  (defun c:RD_ele/form1#OnMouseMovedOff        (/) 
    (dcl-control-setkeepfocus RD_ele/form1 nil) 
  ) 
 
 
;;;-error function--------------------------------------------------------------- 
;;;------------------------------------------------------------------------------ 
  (defun *error* (msg) 
    (if        (dcl-form-isactive rd_ele/form1) 
      (dcl-form-close rd_ele/form1) 
    ) 
    (entdel (entlast)) 
    (xdrx_pointmonitor) 
    (xdrx_sysvar_pop) 
    (princ "\n canceled ... ... ... ... ") 
    (princ) 
  ) 
  (vl-acad-defun 'dragtext) 
;;;--Create a block function----------------------------------------------------- 
;;;------------------------------------------------------------------------------ 
 
  (defun addNewBlock (name / ss n) 
    (xdrx_setmark 
      (xdrx_polyline_make 
        '((0 0 0) (300 300 0) (-300 300 0) (0 0 0)) 
      ) 
    ) 
    (entdel (entlast)) 
    (xdrx_polyline_make 
      '((0 0 0) (300 300 0) (-300 300 0) (0 0 0)) 
    ) 
    (xdrx_setpropertyvalue 
      (xdrx_AttributeDef_make 
        (xdrx_text_make '(-580.0 400.0 0.0) "ELE_symbol" 300 0) 
        t 
      ) 
      "textstring" 
      "%%p0.000" 
    ) 
    (setq ss (xdrx_getss)) 
    (xdrx_block_make name ss '(0 0 0)) 
    (setq n -1) 
    (repeat (sslength ss) 
      (entdel (ssname ss (setq n (1+ n)))) 
    ) 
  ) 
 
;;;---callback function------------------------------------------------------------ 
;;;-------------------------------------------------------------------------------- 
 
  (defun dragtext (p) 
    (setq p1   (vlax-curve-getclosestpointto curve p) 
          f1   (vlax-curve-getfirstderiv 
                 curve 
                 (vlax-curve-getparamatpoint curve p1) 
               ) 
          pa0  (vlax-curve-getparamatpoint curve p1) 
          dist (if startp 
                 (vlax-curve-getdistatparam curve pa0) 
                 (- lth (vlax-curve-getdistatparam curve pa0)) 
               ) 
          an   (xdrx_vector_angle f1) 
          an   (xd::geom:angleformat an) 
    ) 
;;;---The spacing between text and polyline may change abnormally if using API----- 
;;;---So using Vl functions instead------------------------------------------------ 
 
;;;    (foreach n (xdrx_insert_getattribs e) 
;;;      (xdrx_setpropertyvalue 
;;;        n 
;;;        "textstring" 
;;;        (rtos dist 2 3) 
;;;        "rotation" 
;;;        an 
;;;      ) 
;;;    ) 
;;;    (xdrx_setpropertyvalue e "rotation" an) 
;;;    (vla-put-insertionpoint 
;;;      (vlax-ename->vla-object e) 
;;;      (vlax-3d-point p1) 
;;;    ) 
 
;;;---Using vl functions---------------------------------------------------------- 
 
    (setq e1 (vlax-ename->vla-object e)) 
    (foreach each (vlax-safearray->list 
                    (vlax-variant-value (vla-GetAttributes e1)) 
                  ) 
      (vla-put-textstring 
        each 
        (rtos (+ startEle (* dist slope 1e-3)) 2 3) 
      ) 
    ) 
    (vla-put-rotation e1 an) 
    (vla-put-InsertionPoint e1 (vlax-3d-point p1)) 
 
;;;-------------------------------------------------------------------------------- 
  ) 
;;;---end of dragtext ,main program starts----------------------------------------- 
  (xdrx_begin) 
  (if (not (tblsearch "block" "$ele_symbol")) 
    (ADDNEWBLOCK "$ele_symbol") 
  ) 
  (xdrx_sysvar_push '("orthomode" 0) '("autosnap" 55)) 
  (and (setq e0 (entsel "\nselect insert")) 
       (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)) 
                   ) 
                 t 
                 nil 
               ) 
  ) 
  (setq loop t) 
;;;-------------------------------------------------------------------------------   
  (dcl-form-show rd_ele/form1) 
  (while loop 
    (setq slope            (atof (dcl-control-gettext rd_ele/form1/textbox1)) 
          startEle  (atof (dcl-control-gettext rd_ele/form1/textbox2)) 
          dwgScalle (atof (dcl-control-gettext rd_ele/form1/textbox3)) 
    ) 
    (xdrx_initget "s") 
    (setq e (xdrx_insert_make "$ele_symbol" p1 (/ dwgScalle 100) 0)) 
 
    (xdrx_setenttodb e) 
    (if        (and 
          (setq        rtn 
                 (xdrx_drag_jig 
                   "dragtext" 
                   "\nselect the position of text[exit(s)]" 
                   "s" 
                   (+ 128) 
                   0 
                   p1 
                 ) 
          ) 
          (equal (type rtn) 'list) 
        ) 
      (setq loop t) 
      (progn (setq loop nil) 
             (entdel (entlast)) 
             (if (dcl-form-isactive rd_ele/form1) 
               (dcl-form-close rd_ele/form1) 
             ) 
      ) 
    ) 
  ) 
  (if (equal -4 rtn) 
    (progn 
;;;      (entdel (entlast)) 
      (if (dcl-form-isactive rd_ele/form1) 
        (dcl-form-close rd_ele/form1) 
      ) 
    ) 
  ) 
  (xdrx_sysvar_pop) 
  (xdrx_end) 
)

brainstorm · 发表于 2017-8-15 13:51:56

drag_jig效果

newer · 发表于 2017-8-15 13:56:35

本帖最后由 newer 于 2017-8-15 13:59 编辑

brainstorm 发表于 2017-8-15 13:44

拖动文字回调函数里面另外一个用 “对齐” 的思路实现的方法，这个能化复杂的问题为简单的，不用扣细节，如角度等等，就是按照视觉看到的，找到前后对齐轴就可以了。

(xdrx_entity_align ent 原点1 原点2 目标点1 目标点2)
原点2 、目标点2 根据切线向量求出前后两个位置的。

动态标标高.gif

(defun c:tt (/ *error*)
(defun *error* (msg)
(xdrx_pointmonitor)
(xdrx_sysvar_pop)
(princ "\n canceled ... ... ... ... ")
(princ)
)
(vl-acad-defun 'dragtext)
(defun dragtext (p)
(setq p1 (xdrx_curve_getclosestpoint curve p))
(if (not (equal lastpoint p1 1e-3))
(progn
(setq f1 (xdrx_curve_getfirstderiv curve p1)
dist (xdrx_curve_getdistatpoint curve p1)
s_dir (xdrx_entity_direction e)
s_ori (xdrx_getpropertyvalue e "position")
an1 (xdrx_vector_angle s_dir)
an2 (xdrx_vector_angle f1)
)
(if (and
(> an1 (/ pi 2.0))
(< an1 (* 3 (/ pi 2.0)))
)
(setq s_dir (xdrx_vector_negate s_dir))
)
(if (and
(> an2 (/ pi 2.0))
(< an2 (* 3 (/ pi 2.0)))
)
(setq f1 (xdrx_vector_negate f1))
)
(xdrx_entity_align e s_ori (mapcar
'+
s_ori
s_dir
) p1 (mapcar
'+
p1
f1
)
)
(xdrx_setpropertyvalue att "textstring" (rtos dist 2 2))
)
)
(setq lastpoint p1)
)
(xdrx_sysvar_push '("orthomode" 0) '("autosnap" 0))
(while (and
(setq e (car (xdrx_entsel "\n选择属性块<退出>:" '((0 . "INSERT")
(66 . 1)
)
)
)
)
(setq curve (car (entsel "\n选择曲线:")))
)
(setq att (car (xdrx_getpropertyvalue e "AttributeEntities")))
(xdrx_pointmonitor "dragtext")
(getpoint "\nselect the position of text")
(xdrx_pointmonitor)
)
(xdrx_sysvar_pop)
)

(defun c:tt (/ *error*) 
  (defun *error* (msg) 
    (xdrx_pointmonitor) 
    (xdrx_sysvar_pop) 
    (princ "\n canceled ... ... ... ... ") 
    (princ) 
  ) 
  (vl-acad-defun 'dragtext) 
  (defun dragtext (p) 
    (setq p1 (xdrx_curve_getclosestpoint curve p)) 
    (if (not (equal lastpoint p1 1e-3)) 
      (progn 
        (setq f1 (xdrx_curve_getfirstderiv curve p1) 
              dist (xdrx_curve_getdistatpoint curve p1) 
              s_dir (xdrx_entity_direction e) 
              s_ori (xdrx_getpropertyvalue e "position") 
              an1 (xdrx_vector_angle s_dir) 
              an2 (xdrx_vector_angle f1) 
        ) 
        (if (and 
              (> an1 (/ pi 2.0)) 
              (< an1 (* 3 (/ pi 2.0))) 
            ) 
          (setq s_dir (xdrx_vector_negate s_dir)) 
        ) 
        (if (and 
              (> an2 (/ pi 2.0)) 
              (< an2 (* 3 (/ pi 2.0))) 
            ) 
          (setq f1 (xdrx_vector_negate f1)) 
        ) 
        (xdrx_entity_align e s_ori (mapcar 
                                     '+ 
                                     s_ori 
                                     s_dir 
                                   ) p1 (mapcar 
                                          '+ 
                                          p1 
                                          f1 
                                        ) 
        ) 
        (xdrx_setpropertyvalue att "textstring" (rtos dist 2 2)) 
      ) 
    ) 
    (setq lastpoint p1) 
  ) 
  (xdrx_sysvar_push '("orthomode" 0) '("autosnap" 0)) 
  (while (and 
           (setq e (car (xdrx_entsel "\n选择属性块<退出>:" '((0 . "INSERT") 
                                      (66 . 1) 
                                     ) 
                        ) 
                   ) 
           ) 
           (setq curve (car (entsel "\n选择曲线:"))) 
         ) 
    (setq att (car (xdrx_getpropertyvalue e "AttributeEntities"))) 
    (xdrx_pointmonitor "dragtext") 
    (getpoint "\nselect the position of text") 
    (xdrx_pointmonitor) 
  ) 
  (xdrx_sysvar_pop) 
)

brainstorm · 发表于 2017-8-15 14:52:10

API 太强大了就是没学明白

liuyj · 发表于 2017-8-15 15:12:31

对话框还是要密码，不能运行

newer · 发表于 2017-8-15 15:21:34

brainstorm 发表于 2017-8-15 14:52

多看手册，多用函数就熟了。
手册分类看，看向量里面都有什么，矩阵里面都有什么.....
向量、矩阵、实体变换 transform 这些都是最底层的

xdrx_entity_move,xdrx_entity_copy,xdrx_entity_mirror,xdrx_entity_rotate,xdrx_entity_align这些都是用上面的矩阵变换包装的，用上面的矩阵函数也可以写出上面这些。

实体的变换（移动）是：xdrx_entity_transform
实体的变换（拷贝）是：xdrx_entity_transformedCopy

用API写LISP程序，实际上潜移默化的受ARX写代码的流程影响。

API 一行代码完成一个任务（用LISP实现要N多代码），
几行API代码就完成了一个程序，易读易懂，实现的内部完全就是ARX的高效率。

多看看向量和矩阵的函数，然后搜索下论坛。

brainstorm · 发表于 2017-8-15 16:16:15

本帖最后由 brainstorm 于 2017-8-15 16:19 编辑

liuyj 发表于 2017-8-15 15:12

把这段删了
(dcl-Project-Import
'("YWt6A7gYAACUsJuiBuKTJjMxLT9qQ3GkTL/UPhycPHN48jpTyrtcCx/yv7pWJn9dUPKML1Rvevx0"
   "unMlbVoP2/fEDhsihueGbyPGvvOQIsYOn3FOLxoZclSLsMqOoEX3Smv1eESzyg2YsKIJoeMFkOPK"
   "WkflOsSFJK7+LZY44Qp1vqVc3iZxOiYn+VC6z21v+i/5Vnw2dpDs5/7n0+sPfuNc9V5aXVN3NTE2"
   "qd3esqjfXYvO2qjmPsM23KZb4c42fIwmw0kcSgj2Wlbd1racOB02yrkbM9MCigm6lvLedgATmlSW"
   "yH+0PH+sM2CdMx5+PUZVNasxhqx8NeXfEGxgWALvDuyOebxd+tHHjrhQkvituUvOE9U+coMWbAJ/"
   "mTrIIa4Hh2PsYPnEkqzKV2UzBEoSyroaK3y0GcfTgjAo8WwoyoBLtJiC5QjKFP8ZEDRh+2RNQdgD"
   "6r0o7Y68ryrnU5Gvxq4MkQEYtbOEWfrhbAAyhnmnLZ90d7EalR6JtY+AT4u4S3ErG5XHXaPRIcKq"
   "vkNiKZTWhgoqsBbhhgkqvC8HtzGJtvGJd9FfokkRyk88i2xARRHiiytFC/6aGXYJ7IA1+qV2CW1g"
   "WQL9jne8LY2AN58npWANdiG2wLG8IlnQ2oOtiIVkB3xnnc5+FBA0qy5yegFh3U2k42BFOPNCGLXL"
   "LIuuoBGYYO/AHLxijdv6hSOfmhE8VbTbiWY0ibfGP8AxPcPOk+asCKjtY3BQ06mGVKfP4+DFsCAB"
   "Pp1dSBCpBnkPVz4GZUOBa58YjKUYqQVo+FoVed/UkyuhuBqrWRycaMyMzvO1S0A6KEtsEFwC7g7q"
   "0pgyzuvClrZyuduFi5RsfdVHTYZk2wYL5B3q0p7Z1ptSj36nG/PFR7BksoQizUR99cfsBlbk59tA"
   "CdjhF+BDiNAJQsgWiIBXJefjdc6vppEenVPGpxpUmyyNWnUgql0jT6lk5tcc+I1rDYcoslSCo/Qn"
   "9mslT9OS1NuPwl11krsBLFMpZcYuy3KZ1Z**zVtWSpTOVjgcWiLwsHAbNQbMAbsE8uq1YN4ULr1"
   "LuBpNbl17Z/3adMp2FlEpBDhInfCToVjwha5QcQ72HBKrVNM6sE7UKEl2p8cgGjnvPXFOwT9LByK"
   "QVHv0hDtR7d49cIzlIh1+LiqXA=="
   )
  )

改为(dcl-project-load "rd_ele")试试，我上传了一个odcl原文件
我没设密码，如果还不行请N老师看看吧

brainstorm · 发表于 2017-8-15 16:23:23

newer 发表于 2017-8-15 15:21

是的 API效率很高值得学习

kqqt6236 · 发表于 2017-8-16 00:09:41

谢谢分享。

jwj0805 · 发表于 2017-8-16 00:18:07

看到过这种插件，实现起来感觉挺麻烦的

zhouzhiy · 发表于 2017-8-16 07:53:48

谢谢楼主分享！

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

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

评分

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