非模式对话框的测量长度和面积的工具

XDSoft · 发表于 2016-7-8 15:38:28

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

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

×

测量长度和面积
1、支持绘图单位，根据米或者毫米绘图，得到正确值
2、可以局部测量曲线的长度
3、有当前值和累加值的统计
4、测绘标注可选择保留或删除
5、测量过程中可以回退
6、可批量、可单选、可局部
。。。

需要的函数到开源LISP函数库论坛下载：1、XD::Drag:CallBackSetMouseMove
2、XD::Drag:CallBackSetMouseLeftClick
3、XD::Doc:GetPolygon

测量面积部分的演示：

测量长度面积（2）.gif

游客，如果您要查看本帖隐藏内容请回复

formz · 发表于 2016-7-9 23:24:59

這個太棒了，很不錯

formz · 发表于 2016-7-9 23:29:40

這個太棒了，很不錯

liuyj · 发表于 2016-7-10 20:11:37

又一个神器

liuyj · 发表于 2016-7-11 11:44:03

本帖最后由 liuyj 于 2016-7-11 11:45 编辑

提示“password incorrect”是咋回事？

newer · 发表于 2016-7-11 13:45:48

liuyj 发表于 2016-7-11 11:44
提示“password incorrect”是咋回事？

什么时候提示的？

liuyj · 发表于 2016-7-11 14:03:00

加载程序后，输入命令就提示了，接着出来一个对话框说“OPENDCL函数参数处理发生异常”，不允许NIL值。然后就退出

newer · 发表于 2016-7-11 16:05:54

liuyj 发表于 2016-7-11 14:03
加载程序后，输入命令就提示了，接着出来一个对话框说“OPENDCL函数参数处理发生异常”，不允许NIL值。然后 ...

你用OPENDCL是8.05版本吗？第一次有提示，再执行还有提示吗？

liuyj · 发表于 2016-7-11 16:13:10

“OpenDCL Runtime [8.0.5.0] 已加载。"没问题。执行几次都一样

newer · 发表于 2016-7-11 16:27:08

liuyj 发表于 2016-7-11 16:13
“OpenDCL Runtime [8.0.5.0] 已加载。"没问题。执行几次都一样

你把初始化部分里面的 **setvalue 一个一个加入，看看在加入哪个后，出来提示？

(defun c:XD-CURVE-LENGTH#OnInitialize (/)
(setq cur-ents nil)
(if (not #xd-var-global-curve-length-tatallength)
(setq #xd-var-global-curve-length-tatallength 0.0)
)
(setq ent-nums 0)
(if (not #xd-var-global-curve-length-tatalarea1)
(setq #xd-var-global-curve-length-tatalarea1 0.0)
)
(dcl-Control-SetTitleBarText XD-CURVE-LENGTH "长度面积")
(if (not #xd-odcl-curve-length-data)
(setq #xd-odcl-curve-length-data (list '("COLOR" 3) '("WIDTH" 0.0) '
("HEIGHT" 6) '
("ISERASE" 0)
)
)
)
(dcl-ComboBox-SetCurSel XD-CURVE-LENGTH-COLOR (cadr (assoc "COLOR" #xd-odcl-curve-length-data)))
(dcl-Control-SetText XD-CURVE-LENGTH-WIDTH (vl-prin1-to-string
(cadr
(assoc "WIDTH" #xd-odcl-curve-length-data)
)
)
)
(dcl-Control-SetText XD-CURVE-LENGTH-HEIGHT (vl-prin1-to-string
(cadr
(assoc "HEIGHT" #xd-odcl-curve-length-data)
)
)
)
(dcl-Control-SetText XD-CURVE-LENGTH-CDISTANCE "0")
(dcl-Control-SetText XD-CURVE-LENGTH-CAREA1 "0")
(dcl-Control-SetText XD-CURVE-LENGTH-carea2 "0")
(dcl-Control-SetText XD-CURVE-LENGTH-DISTANCE (rtos #xd-var-global-curve-length-tatallength
2 1
)
)
(dcl-Control-SetText XD-CURVE-LENGTH-AREA1 (rtos #xd-var-global-curve-length-tatalarea1
2 1
)
)
(dcl-Control-SetText XD-CURVE-LENGTH-AREA2 (rtos (* #xd-var-global-curve-length-tatalarea1
666.6666667
) 2 1
)
)
(dcl-Control-SetValue XD-CURVE-LENGTH-ISERASE (cadr (assoc "ISERASE" #xd-odcl-curve-length-data)))
(princ)
)

(defun c:XD-CURVE-LENGTH#OnInitialize (/) 
    (setq cur-ents nil) 
    (if (not #xd-var-global-curve-length-tatallength) 
      (setq #xd-var-global-curve-length-tatallength 0.0) 
    ) 
    (setq ent-nums 0) 
    (if (not #xd-var-global-curve-length-tatalarea1) 
      (setq #xd-var-global-curve-length-tatalarea1 0.0) 
    ) 
    (dcl-Control-SetTitleBarText XD-CURVE-LENGTH "长度面积") 
    (if (not #xd-odcl-curve-length-data) 
      (setq #xd-odcl-curve-length-data (list '("COLOR" 3) '("WIDTH" 0.0) ' 
                                             ("HEIGHT" 6) ' 
                                             ("ISERASE" 0) 
                                       ) 
      ) 
    ) 
    (dcl-ComboBox-SetCurSel XD-CURVE-LENGTH-COLOR (cadr (assoc "COLOR" #xd-odcl-curve-length-data))) 
    (dcl-Control-SetText XD-CURVE-LENGTH-WIDTH (vl-prin1-to-string 
                                                                   (cadr 
                                                                         (assoc "WIDTH" #xd-odcl-curve-length-data) 
                                                                   ) 
                                               ) 
    ) 
    (dcl-Control-SetText XD-CURVE-LENGTH-HEIGHT (vl-prin1-to-string 
                                                                    (cadr 
                                                                          (assoc "HEIGHT" #xd-odcl-curve-length-data) 
                                                                    ) 
                                                ) 
    ) 
    (dcl-Control-SetText XD-CURVE-LENGTH-CDISTANCE "0") 
    (dcl-Control-SetText XD-CURVE-LENGTH-CAREA1 "0") 
    (dcl-Control-SetText XD-CURVE-LENGTH-carea2 "0") 
    (dcl-Control-SetText XD-CURVE-LENGTH-DISTANCE (rtos #xd-var-global-curve-length-tatallength 
                                                        2 1 
                                                  ) 
    ) 
    (dcl-Control-SetText XD-CURVE-LENGTH-AREA1 (rtos #xd-var-global-curve-length-tatalarea1 
                                                     2 1 
                                               ) 
    ) 
    (dcl-Control-SetText XD-CURVE-LENGTH-AREA2 (rtos (* #xd-var-global-curve-length-tatalarea1 
                                                        666.6666667 
                                                     ) 2 1 
                                               ) 
    ) 
    (dcl-Control-SetValue XD-CURVE-LENGTH-ISERASE (cadr (assoc "ISERASE" #xd-odcl-curve-length-data))) 
    (princ) 
  )

上面这个初始化函数，你把下面带颜色的，上面的删除，然后一次加一行，看看到哪行出错

(dcl-ComboBox-SetCurSel XD-CURVE-LENGTH-COLOR (cadr (assoc "COLOR" #xd-odcl-curve-length-data)))
(dcl-Control-SetText XD-CURVE-LENGTH-WIDTH (vl-prin1-to-string
                                                               (cadr
                                                                     (assoc "WIDTH" #xd-odcl-curve-length-data)
                                                               )
                                             )
)
(dcl-Control-SetText XD-CURVE-LENGTH-HEIGHT (vl-prin1-to-string
                                                                  (cadr
                                                                        (assoc "HEIGHT" #xd-odcl-curve-length-data)
                                                                  )
                                             )
)
(dcl-Control-SetText XD-CURVE-LENGTH-CDISTANCE "0")
(dcl-Control-SetText XD-CURVE-LENGTH-CAREA1 "0")
(dcl-Control-SetText XD-CURVE-LENGTH-carea2 "0")
(dcl-Control-SetText XD-CURVE-LENGTH-DISTANCE (rtos #xd-var-global-curve-length-tatallength
                                                      2 1
                                                )
)
(dcl-Control-SetText XD-CURVE-LENGTH-AREA1 (rtos #xd-var-global-curve-length-tatalarea1
                                                   2 1
                                             )
)
(dcl-Control-SetText XD-CURVE-LENGTH-AREA2 (rtos (* #xd-var-global-curve-length-tatalarea1
                                                      666.6666667
                                                   ) 2 1
                                             )
)
(dcl-Control-SetValue XD-CURVE-LENGTH-ISERASE (cadr (assoc "ISERASE" #xd-odcl-curve-length-data)))
[/code]

liuyj · 发表于 2016-7-11 18:40:42

运行(dcl-project-import odcl-length)这句出现“password incorrect”，运行(dcl-Control-SetTitleBarText XD-CURVE-LENGTH "长度面积")时出现“OPENDCL函数参数处理发生异常”，“不允许NIL值”，好像是没找到对话框文件。

st788796 · 发表于 2016-7-11 19:27:42

odcl文件设了密码保护

XDSoft · 发表于 2016-7-11 19:40:12

我看看，没设过密码保护啊。

liuchong1988 · 发表于 2016-7-11 19:47:38

谢谢分享！

sachindkini · 发表于 2016-7-11 20:07:20

dear sir nice tool

[工具] 非模式对话框的测量长度和面积的工具

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

相关帖子

点评

点评

点评

点评

点评

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