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

 找回密码
 立即注册

QQ登录

只需一步，快速开始

扫一扫，访问微社区

晓东CAD家园-论坛»论坛 › ╃CAD编程开发 › 晓东工具箱、编程申请 › 求引线标注倒角lisp代码
返回列表 发新帖
查看: 3419|回复: 10

[编程申请] 求引线标注倒角lisp代码

[复制链接]
lucas3

已领礼包: 3199个

财富等级: 富可敌国
发表于 2013-12-30 15:16:08 | 显示全部楼层 |阅读模式
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略

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

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

×
20121227.jpg

如图所示，求引线标注倒角lisp程序，非引线标注的vlisp程序就不需要了，论坛上也有好多
引线标注倒角效果跟INVENTOR工程图里的倒角是一样的
谢谢和位大师的帮忙！万分感谢！


程序

相关帖子

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

使用道具 举报

zxq0220

已领礼包: 10237个

财富等级: 富甲天下
发表于 2013-12-31 08:00:35 | 显示全部楼层
没有那么合适的。
  2. (DEFUN C:DIMCHAMFER ()
  3. (SETVAR "CMDECHO" 0)
  4. (SETQ OLDOS (GETVAR "OSMODE"))
  5. (SETQ OLDZIN (GETVAR "DIMZIN"))
  6. (SETVAR "DIMZIN" 8)
  7. (SETVAR "OSMODE" 0)
  8. (SETQ DL (ENTGET (CAR (ENTSEL "\nPlease Select a Line 请选择一条直线 :"))))
  9. (WHILE (/= (CDR (ASSOC 0 DL)) "LINE")
  10.   (PRINC "\nError!")
  11.   (SETQ DL (ENTGET (CAR (ENTSEL "\nPlease Select a Line 请选择一条直线 :"))))
  12. )
  13. (SETQ P1 (CDR (ASSOC 10 DL))
  14.        P2 (CDR (ASSOC 11 DL))
  15.        X (ABS (- (CAR P1) (CAR P2)))
  16.        Y (ABS (- (CADR P1) (CADR P2))))
  17. (IF (EQUAL X Y 1E-4) (PROGN
  18. ;  (PRINC "\n倒角尺寸<") (PRINC (RTOS X 2 3))
  19. ;  (SETQ TT (GETSTRING "> :")
  20. ;        TT (IF (= TT "") (RTOS X 2 3) TT))
  21. ;  (SETQ TT (IF (> (- X (FIX X)) 0) TT (STRCAT TT ".0"))
  22. ;        TT (STRCAT TT "x45%%d")
  23. ;        OLDASZ (GETVAR "DIMASZ")
  24. ;        P4 (POLAR P1 (ANGLE P1 P2) (* (DISTANCE P1 P2) 0.5)))
  25.    (SETQ TT (STRCAT (RTOS X 2 3) "x45%%d")
  26.          OLDASZ (GETVAR "DIMASZ")
  27.          P4 (POLAR P1 (ANGLE P1 P2) (* (DISTANCE P1 P2) 0.5)))
  28.   (SETVAR "DIMASZ" 0)
  29.   (SETVAR "SNAPANG" (/ PI 4))
  30.   (IF (SETQ P3 (GETPOINT P4 "\nText Point 文字点? ")) (PROGN
  31.    (SETQ P4 (IF (> (DISTANCE P3 P1) (DISTANCE P3 P2)) P2 P1)
  32. ;        P5 (POLAR P3 (/ PI 2) (* (GETVAR "DIMGAP") 2))
  33.    )
  34.    (COMMAND "LEADER" P4 P3 "" TT "")
  35.   ))
  36.   (SETVAR "SNAPANG" 0)
  37.   (SETVAR "DIMASZ" OLDASZ)
  38. ))
  39. (SETVAR "DIMZIN" OLDZIN)
  40. (SETVAR "OSMODE" OLDOS)
  41. (SETVAR "CMDECHO" 1)
  42. (PRINC)
  43. )

点评

lucas3
谢谢你的回复，此代码不支持多段线，另外只能标C角，倒角边不一样长的不能标，更重要的一点非引线标注。看来小小的一个倒角功能，不简单啊  详情 回复 发表于 2013-12-31 11:52
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

lucas3

已领礼包: 3199个

财富等级: 富可敌国
 楼主| 发表于 2013-12-31 11:52:18 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
本帖最后由 lucas3 于 2013-12-31 12:08 编辑
zxq0220 发表于 2013-12-31 08:00
没有那么合适的。

谢谢你的回复，此代码不支持多段线，另外只能标C角，倒角边不一样长的不能标，更重要的一点非引线标注。看来小小的一个倒角功能，不简单啊

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

使用道具 举报

lucas3

已领礼包: 3199个

财富等级: 富可敌国
 楼主| 发表于 2014-1-2 19:05:45 | 显示全部楼层
高手很多，可是没多少人愿意帮忙啊

点评

newer
你能把INVENTOR里面的该功能，做个动画图片贴上来演示下吗？  详情 回复 发表于 2014-1-2 21:34
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

newer

已领礼包: 40个

财富等级: 招财进宝
发表于 2014-1-2 21:34:45 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
lucas3 发表于 2014-1-2 19:05
高手很多，可是没多少人愿意帮忙啊

你能把INVENTOR里面的该功能，做个动画图片贴上来演示下吗？

点评

flyfox1048
我觉得Mechanical 里的倒角标注要比INV更强大！ 做了一个，不理想，还望版主改进  详情 回复 发表于 2014-1-2 22:30
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2014-1-2 21:55:21 来自手机 | 显示全部楼层
有过一个标倒角的程序，改一改应该就可以
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

flyfox1048
发表于 2014-1-2 22:30:25 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
newer 发表于 2014-1-2 21:34
你能把INVENTOR里面的该功能，做个动画图片贴上来演示下吗？

我觉得Mechanical 里的倒角标注要比INV更强大！
做了一个，不理想，还望版主改进
  1. (defun c:test (/ x1 x2 y1 y2 points point1 point2 point_1 point_2)
  2.         ;获取多段线顶点
  3.         (setq points '())
  4.     (setq entselect (entsel))
  5.         (setq entname (car entselect))
  6.     (setq select_point (cadr entselect))
  7.     (setq x (car select_point) y (cadr select_point))
  8.     (setq ent (entget entname))
  9.         (if (equal  (cdr (assoc 0 ent))  "LINE" )
  10.         (progn
  11.       (setq point_1 (cdr (assoc 10 ent))   point_2 (cdr (assoc 11 ent))  )
  12.       (setq x1 (car point_1) y1 (cadr point_1) x2 (car point_2) y2 (cadr point_2))
  13.       (setq le_point (list (* 0.5 (+ x1 x2)) (* 0.5 (+ y1 y2)) ))
  14.       )
  15.      
  16.     (progn
  17.     (mapcar '(lambda (x)  (cond
  18.                                       ((= 10 (car x))  (setq points (cons (cdr x) points)) )   
  19.                              )
  20.              )
  21.          ent
  22.     )
  23.       (setq add_point (car points))
  24.     (setq points (reverse points))
  25.     (setq points (cons add_point points))
  26.     (setq points (reverse points))

  28.     (princ 'lyt)
  29.     ;获取所标注倒角顶点
  30.     (setq judgement 1)
  31.     (while judgement
  32.            (setq point1 (car points))
  33.          (setq point2 (cadr points))
  34.          (setq x1 (car point1) y1 (cadr point1) x2 (car point2) y2 (cadr point2))
  35.          
  36.          (if (and (or (and (< x x1) (> x x2)) (and (< x x2) (> x x1))) (or (and (< y y1) (> y y2)) (and (< y y2) (> y y1))))
  37.               (progn
  38.           (setq point_1 point1 point_2 point2 judgement 'nil)
  39.           )
  40.          )
  41.          
  42.          (setq points (cdr points))
  43.     )
  44.     (setq x1 (car point_1) y1 (cadr point_1) x2 (car point_2) y2 (cadr point_2))
  45.     (setq le_point (list (* 0.5 (+ x1 x2)) (* 0.5 (+ y1 y2)) ))
  46.    
  47.     )
  48.     )
  49.    
  50.    
  51.    
  52.     ;计算倒角并标注
  53.     (setq choice1 (abs (- y1 y2))   )
  54.     (setq choice2 (abs (- x1 x2))   )
  55.     (if (= choice1 choice2)
  56.         (setq choice (strcat "C" (rtos choice1 2 1)))
  57.       (setq choice (strcat  (rtos choice1 2 1) "x" (rtos choice2 2 1)))
  58.     )
  59.     (setq height 2.5)
  60.     (command "qleader" le_point pause pause)
  61.     (setq ent (entget (entlast)))
  62.     (setq points '(""))
  63.       (mapcar '(lambda (x)
  64.                          (cond
  65.                                  ((= 10 (car x)) (setq points (cons (cdr x) points)))            
  66.                  )
  67.                  )
  68.          ent
  69.        )
  70.       (setq point_end   (car  points))
  71.       (setq point_start (cadr points))
  72.       (if (> (- (car point_end) (car point_start)) 0)
  73.           (progn
  74.                (setq point (list (+ (car point_end)  (* 0.7 height)) (- (cadr point_end) (* 0.5 height))))
  75.                  (command "text" point height 0 choice )
  76.         )
  77.        (progn
  78.                (setq point (list (- (car point_end) (* 0.7 height) ) (- (cadr point_end) (* 0.5 height))))
  79.            (princ point)
  80.                  (command "text" point height 0 choice )
  81.                    (setq entname (entlast))
  82.                (setq ent (entget entname))
  83.                (entmod
  84.                      (mapcar '(lambda ( x)
  85.                                      (cond
  86.                                             ((= (car x) 72) (cons (car x)  2))
  87.                                 ((= (car x) 11) (cons (car x)  point))
  88.                                 (t x)
  89.                                 )
  90.                         )
  91.                              ent
  92.                     )
  93.                 )     
  94.         )
  95.       )

  97. )



点评

flyfox1048
说说一些不足，1.先要qleader ，设置将“注释类型”设为无 2.标注时，值是跟在引线后面，而不是在引线上方 3.对于倾斜的图形，标注就出错，上个图片说明思路, 自己能力有限，又没多少业余有时间，望高手们完善  详情 回复 发表于 2014-1-2 22:44
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

flyfox1048
发表于 2014-1-2 22:44:31 | 显示全部楼层
flyfox1048 发表于 2014-1-2 22:30
我觉得Mechanical 里的倒角标注要比INV更强大！
做了一个，不理想，还望版主改进

说说一些不足，1.先要qleader ，设置将“注释类型”设为无
2.标注时，值是跟在引线后面，而不是在引线上方
3.对于倾斜的图形，标注就出错，上个图片说明思路,  自己能力有限，又没多少业余有时间，望高手们完善

错误的标注
QQ图片20140102223716.jpg



正确的做法是：1先选择倒角边，2选择一条引用边，3选择另一条引用边
QQ图片20140102223827.jpg


完善的做法是做一个选择 ，两种标注方式，一种正常标注，一种引线标注，引线标注就是我们讨论的这种，另一种应该是这样
QQ图片20140102224258.jpg


进一步完善就应该加入标注文字高度设置 ，将标注放入dim层

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

使用道具 举报

st788796

已领礼包: 1268个

财富等级: 财源广进
发表于 2014-1-2 23:20:23 来自手机 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
点倒角线自动找前后段，由段的LineSeg求交点就有倒角距离，取中点后调用命令或api vla均可
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

lucas3

已领礼包: 3199个

财富等级: 富可敌国
 楼主| 发表于 2014-1-3 14:29:05 | 显示全部楼层
喔，这么多回复，感动ing!谢谢fly ,你说的思路很不错，只是不懂LISP，能帮我再改改吗
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能，那里可能会有你要找的答案；
如果你在论坛求助问题，并且已经从坛友或者管理的回复中解决了问题，请把帖子标题加上【已解决】；
如何回报帮助你解决问题的坛友，一个好办法就是给对方加【D豆】，加分不会扣除自己的积分，做一个热心并受欢迎的人！
回复 支持 反对

使用道具 举报

Lisphk

已领礼包: 19个

财富等级: 恭喜发财
发表于 2016-9-17 23:39:27 | 显示全部楼层
【广而告之】积分规则、D豆获取攻略       窝窝空间装扮攻略
lucas3 发表于 2014-1-3 14:29

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-9-21 05:44 , Processed in 0.237526 second(s), 62 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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