设为首页收藏本站转
发帖领奖家园QQ群申请版主版主评价切换到宽版

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › A/VLISP › 尺寸检查之一
返回列表 发新帖
查看: 3437|回复: 16

[每日一码] 尺寸检查之一

[复制链接]
/db_自贡黄明儒_

已领礼包: 604个

财富等级: 财运亨通
发表于 2013-6-23 09:16:06 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
尺寸标注错误，可能加工出来的零件报废
标注起末点通常是在起点，交点，或者圆心，如果不是这些，那么就当重视之
  1. ;;;6 功能：尺寸起末点不在线端点数值显示红色
  2. ;;; ======================================
  3. (defun CheckDimesionEndPoint (/ ENT I LST NAME SS)
  4.   ;;线、弧端点列表
  5.   (defun EndPointLists (/ ENT I LST NAME SS TYP)
  6.     (if        (setq ss (ssget "X" '((0 . "*LINE,ARC,CIRCLE"))))
  7.       (repeat (setq i (sslength ss))
  8.         (setq name (ssname ss (setq i (1- i)))
  9.               ent  (entget name)
  10.               typ  (cdr (assoc 0 ent))
  11.         )
  12.         (cond
  13.           ((member typ '("PLINE" "LWPOLYLINE" "CIRCLE"))
  14.            (foreach x ent
  15.              (if (= (car x) 10)
  16.                (setq lst (cons (cdr x) lst))
  17.              )
  18.            )
  19.           )
  20.           ((= typ "LINE")
  21.            (setq lst (cons (cdr (assoc 11 ent)) lst))
  22.            (setq lst (cons (cdr (assoc 10 ent)) lst))
  23.           )
  24.           ((= typ "ARC")
  25.            (setq lst (cons (polar (cdr (assoc 10 ent))
  26.                                   (cdr (assoc 50 ent))
  27.                                   (cdr (assoc 40 ent))
  28.                            )
  29.                            lst
  30.                      )
  31.            )
  32.            (setq lst (cons (polar (cdr (assoc 10 ent))
  33.                                   (cdr (assoc 51 ent))
  34.                                   (cdr (assoc 40 ent))
  35.                            )
  36.                            lst
  37.                      )
  38.            )
  39.            (setq lst (cons (cdr (assoc 10 ent)) lst))
  40.           )
  41.         )
  42.       )
  43.     )
  44.     lst
  45.   )
  46.   ;;尺寸检查主程序
  47.   (if (setq ss (ssget "X" '((0 . "DIMENSION"))))
  48.     (progn (setq lst (EndPointLists))
  49.            (repeat (setq i (sslength ss))
  50.              (setq name        (ssname ss (setq i (1- i)))
  51.                    ent        (entget name)
  52.              )
  53.              (if (and (member (cdr (assoc 13 ent)) lst) (member (cdr (assoc 14 ent)) lst))
  54.                nil
  55.                (vlax-put-property (vlax-ename->vla-object name) "textcolor" 1)
  56.              )
  57.            )
  58.     )
  59.   )
  60.   (princ)
  61. )

评分

参与人数 2D豆 +15 收起 理由
XDSoft + 10 很给力!经验；技术要点；资料分享奖！
牢固 + 5 很给力!经验；技术要点；资料分享奖！

查看全部评分

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

使用道具 举报

/db_自贡黄明儒_

已领礼包: 604个

财富等级: 财运亨通
 楼主| 发表于 2013-6-23 09:16:45 | 显示全部楼层
本帖最后由 /db_自贡黄明儒_ 于 2013-6-23 09:18 编辑

如果以上程序运行太慢的话，那么可以用下面的办法
  1. ;;6.1  返回当前视窗左下角和右上角 坐标
  2.   (defun viewpnts (/ a b c d x)
  3.     (setq b (getvar "viewsize")
  4.     c (car (getvar "screensize"))
  5.     d (cadr (getvar "screensize"))
  6.     a (* b (/ c d))
  7.     x (setq x (getvar "viewctr"))
  8.     x (trans x 1 2)
  9.     c (list (- (car x) (/ a 2.0)) (- (cadr x) (/ b 2.0)) 0.0)
  10.     d (list (+ (car x) (/ a 2.0)) (+ (cadr x) (/ b 2.0)) 0.0)
  11.     c (trans c 2 1)
  12.     d (trans d 2 1)
  13.     )
  14.     (list c d)
  15.   )
  16.   ;;6.2 功能：尺寸起末点不在线端点数值显示红色
  17.   (defun CheckDimesionEndPoint
  18.    (/ ENT I LST NAME POINT13 POINT14 PT3 PT4 SS)
  19.     (setq lst (viewpnts))
  20.     (if  (setq ss (ssget "W" (car lst) (cadr lst) '((0 . "DIMENSION"))))
  21.       (progn ;;(command "._zoom" "_E")
  22.        (repeat (setq i (sslength ss))
  23.          (setq name (ssname ss (setq i (1- i)))
  24.          ent  (entget name)
  25.          )
  26.          (setq point13 (cdr (assoc 13 ent)))
  27.          (setq point14 (cdr (assoc 14 ent)))
  28.          (setq pt3 (osnap point13 "_end,_int,_cen"))
  29.          (setq pt4 (osnap point14 "_end,_int,_cen"))
  30.          (if (and  (equal point13 pt3 0.0001)
  31.       (equal point14 pt4 0.0001)
  32.        )
  33.      nil
  34.      (vlax-put-property
  35.        (vlax-ename->vla-object name)
  36.        "textcolor"
  37.        1
  38.      )
  39.          )
  40.        )
  41.       )
  42.     )
  43.     ;;(command "._zoom" "_P")
  44.     (princ)
  45.   )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Free-Lancer
发表于 2013-6-23 09:19:14 来自手机 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
cad的尺寸关键就可以解决吧来自: Android客户端

点评

/db_自贡黄明儒_
仅尺寸关联是不够的，有时移动、复制粘贴等原因,尺寸未必在端点处。之所以想到这个程序，那是我自己血的教训，加工出来的缺口小了，幸好还可以再加工一刀，被比我更老的工程师演讲了一番：标注基点都不会？  详情 回复 发表于 2013-6-23 09:57
/db_自贡黄明儒_
我是说如是这些尺寸不是故意这样标注的，要重视。通常不应该这样标注的吧,我想.  发表于 2013-6-23 09:26
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

/db_自贡黄明儒_

已领礼包: 604个

财富等级: 财运亨通
 楼主| 发表于 2013-6-23 09:57:02 | 显示全部楼层
Free-Lancer 发表于 2013-6-23 09:19
cad的尺寸关键就可以解决吧

仅尺寸关联是不够的，有时移动、复制粘贴等原因,尺寸未必在端点处。之所以想到这个程序，那是我自己血的教训，加工出来的缺口小了，幸好还可以再加工一刀:'(，被比我更老的工程师演讲了一番：标注基点都不会？
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

HLCAD

已领礼包: 5679个

财富等级: 富甲天下
发表于 2013-6-23 15:47:57 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
支持黄大侠的源码！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

myfrankie
发表于 2013-6-23 17:49:06 | 显示全部楼层
如何使用。怎么找不到命令
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

njshf
发表于 2013-6-24 03:36:06 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
我标注的尺寸,在圆心怎么全部标红,看来还不好使.

点评

/db_自贡黄明儒_
这样就妥了  详情 回复 发表于 2013-6-26 11:45
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Free-Lancer
发表于 2013-6-24 12:55:40 来自手机 | 显示全部楼层
cen捕捉在空地方找不到圆心的，要在实体处捕捉来自: Android客户端

点评

/db_自贡黄明儒_
看来得改一下  发表于 2013-6-24 13:27
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

/db_自贡黄明儒_

已领礼包: 604个

财富等级: 财运亨通
 楼主| 发表于 2013-6-26 11:45:46 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
njshf 发表于 2013-6-24 03:36
我标注的尺寸,在圆心怎么全部标红,看来还不好使.

这样就妥了
  1. ;;6.2 功能：尺寸起末点不在线端点数值显示红色
  2.   (defun CheckDimesionEndPoint
  3.              (/ ENT I LST NAME POINT13 POINT14 PT3 PT4 SS SS1)
  4.     (setq lst (viewpnts))
  5.     (if  (setq ss (ssget "W" (car lst) (cadr lst) '((0 . "DIMENSION"))))
  6.       (progn
  7.   (if (setq ss1 (ssget "C" (car lst) (cadr lst) '((0 . "ARC,CIRCLE"))))
  8.     (repeat (setq i (sslength ss1))
  9.       (setq ent (entget (ssname ss1 (setq i (1- i)))))
  10.       (setq lst (cons (cdr (assoc 10 ent)) lst))
  11.     )
  12.   )
  13.   (repeat  (setq i (sslength ss))
  14.     (setq  name (ssname ss (setq i (1- i)))
  15.     ent  (entget name)
  16.     )
  17.     (setq point13 (cdr (assoc 13 ent)))
  18.     (setq point14 (cdr (assoc 14 ent)))
  19.     (setq pt3 (osnap point13 "_end,_int"))
  20.     (setq pt4 (osnap point14 "_end,_int"))
  21.     (if (and (or (equal point13 pt3 0.001) (member point13 lst))
  22.        (or (equal point14 pt4 0.001) (member point14 lst))
  23.         )
  24.       nil
  25.       (vlax-put-property
  26.         (vlax-ename->vla-object name)
  27.         "textcolor"
  28.         1
  29.       )
  30.     )
  31.   )
  32.       )
  33.     )
  34.     (princ)
  35.   )

尺寸工具.rar

9.27 KB, 下载次数: 74, 下载积分: D豆 -1 , 活跃度 1

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

使用道具 举报

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

使用道具 举报

ymcui2005

已领礼包: 106个

财富等级: 日进斗金
发表于 2013-12-17 15:08:34 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
出错的机率又可以减少不小了,好东西啊，顶
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

xvjiex

已领礼包: 1094个

财富等级: 财源广进
发表于 2021-5-27 00:36:59 | 显示全部楼层
感谢楼主分享尺寸检查之一！
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

fangseng

已领礼包: 17个

财富等级: 恭喜发财
发表于 2021-5-27 17:55:49 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
如何使用。怎么找不到命令
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

janshyl

已领礼包: 146个

财富等级: 日进斗金
发表于 2021-5-28 07:53:12 | 显示全部楼层
感謝樓主分享 學習了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

hh_lj007

已领礼包: 756个

财富等级: 财运亨通
发表于 2021-5-28 08:26:56 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
好东西，顶起来
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

返回列表 发新帖
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

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

GMT+8, 2025-9-26 08:09 , Processed in 0.233177 second(s), 62 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2025 Discuz! Team.

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