找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 9535|回复: 134

[每日一码] 标注多段线各边长度及夹角

 火.. [复制链接]

已领礼包: 19个

财富等级: 恭喜发财

发表于 2017-7-25 11:35:19 | 显示全部楼层 |阅读模式

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

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

×
本帖最后由 Lisphk 于 2017-7-25 11:39 编辑

ticks.png


  1. (defun c:dimpolygons (/              *error* mr_IsPointInside              mid
  2.                       adoc    spc     sel     d              i              lw
  3.                       enx     pl      lwn     enxn    plni    plno
  4.                       plnom   plm     clr
  5.                      )
  6.   (vl-load-com)
  7.   (defun *error* (m)
  8.     (vla-endundomark adoc)
  9.     (if        m
  10.       (prompt m)
  11.     )
  12.     (princ)
  13.   )
  14.   (setq clr (getvar "CLAYER"))
  15.   (command "-layer" "Make" "0-Dims" "color" "3" "" "")
  16.       ;; List Clockwise-p - Lee Mac
  17.       ;; Returns T if the point list is clockwise oriented
  18.       (defun LM:ListClockwise-p        (lst)
  19.         (minusp
  20.           (apply
  21.             '+
  22.             (mapcar
  23.               (function        (lambda        (a b)
  24.                           (- (* (car b) (cadr a)) (* (car a) (cadr b)))
  25.                         )
  26.               )
  27.               lst
  28.               (cons (last lst) lst)
  29.             )
  30.           )
  31.         )
  32.       )
  33.       (defun clockwise-p (p1 p2 p3)
  34.         (< (* (- (car p2) (car p1)) (- (cadr p3) (cadr p1)))
  35.            (* (- (cadr p2) (cadr p1)) (- (car p3) (car p1)))
  36.         )
  37.       )
  38.       (setq l ptlst)
  39.       (while (> (length ptlst) 3)
  40.         (setq p1 (car ptlst)
  41.               p2 (cadr ptlst)
  42.               p3 (caddr ptlst)
  43.         )
  44.         (cond
  45.           ((LM:ListClockwise-p ptlst)
  46.            (if
  47.              (and (clockwise-p p1 p2 p3)
  48.                   (= (length
  49.                        (unique
  50.                          (vl-remove
  51.                            nil
  52.                            (mapcar
  53.                              (function (lambda (a b) (inters p1 p2 a b)))
  54.                              l
  55.                              (cdr (reverse (cons (car l) (reverse l))))
  56.                            )
  57.                          )
  58.                        )
  59.                      )
  60.                      2
  61.                   )
  62.                   (= (length
  63.                        (unique
  64.                          (vl-remove
  65.                            nil
  66.                            (mapcar
  67.                              (function (lambda (a b) (inters p2 p3 a b)))
  68.                              l
  69.                              (cdr (reverse (cons (car l) (reverse l))))
  70.                            )
  71.                          )
  72.                        )
  73.                      )
  74.                      2
  75.                   )
  76.                   (= (length
  77.                        (unique
  78.                          (vl-remove
  79.                            nil
  80.                            (mapcar
  81.                              (function (lambda (a b) (inters p3 p1 a b)))
  82.                              l
  83.                              (cdr (reverse (cons (car l) (reverse l))))
  84.                            )
  85.                          )
  86.                        )
  87.                      )
  88.                      2
  89.                   )
  90.              )
  91.               (progn (setq trl (cons (list p1 p2 p3) trl))
  92.                      (setq ptlst (vl-remove p2 ptlst))
  93.                      (setq ptlst
  94.                             (cdr (reverse (cons (car ptlst) (reverse ptlst)))
  95.                             )
  96.                      )
  97.               )
  98.               (setq ptlst
  99.                      (cdr (reverse (cons (car ptlst) (reverse ptlst))))
  100.               )
  101.            )
  102.           )
  103.           ((not (LM:ListClockwise-p ptlst))
  104.            (if
  105.              (and (not (clockwise-p p1 p2 p3))
  106.                   (= (length
  107.                        (unique
  108.                          (vl-remove
  109.                            nil
  110.                            (mapcar
  111.                              (function (lambda (a b) (inters p1 p2 a b)))
  112.                              l
  113.                              (cdr (reverse (cons (car l) (reverse l))))
  114.                            )
  115.                          )
  116.                        )
  117.                      )
  118.                      2
  119.                   )
  120.                   (= (length
  121.                        (unique
  122.                          (vl-remove
  123.                            nil
  124.                            (mapcar
  125.                              (function (lambda (a b) (inters p2 p3 a b)))
  126.                              l
  127.                              (cdr (reverse (cons (car l) (reverse l))))
  128.                            )
  129.                          )
  130.                        )
  131.                      )
  132.                      2
  133.                   )
  134.                   (= (length
  135.                        (unique
  136.                          (vl-remove
  137.                            nil
  138.                            (mapcar
  139.                              (function (lambda (a b) (inters p3 p1 a b)))
  140.                              l
  141.                              (cdr (reverse (cons (car l) (reverse l))))
  142.                            )
  143.                          )
  144.                        )
  145.                      )
  146.                      2
  147.                   )
  148.              )
  149.               (progn (setq trl (cons (list p1 p2 p3) trl))
  150.                      (setq ptlst (vl-remove p2 ptlst))
  151.                      (setq ptlst
  152.                             (cdr (reverse (cons (car ptlst) (reverse ptlst)))
  153.                             )
  154.                      )
  155.               )
  156.               (setq ptlst
  157.                      (cdr (reverse (cons (car ptlst) (reverse ptlst))))
  158.               )
  159.            )
  160.           )
  161.         )
  162.       )
  163.       (setq
  164.         trl (cons (list (car ptlst) (cadr ptlst) (caddr ptlst)) trl)
  165.       )
  166.       trl
  167.     )
  168.     (defun ptinsidetriangle-p (pt p1 p2 p3)
  169.       (and (not        (or (inters pt p1 p2 p3)
  170.                     (inters pt p2 p1 p3)
  171.                     (inters pt p3 p1 p2)
  172.                 )
  173.            )
  174.            (not        (or (> (+ (distance pt p1) (distance pt p2))
  175.                        (+ (distance p3 p1) (distance p3 p2))
  176.                     )
  177.                     (> (+ (distance pt p2) (distance pt p3))
  178.                        (+ (distance p1 p2) (distance p1 p3))
  179.                     )
  180.                     (> (+ (distance pt p3) (distance pt p1))
  181.                        (+ (distance p2 p3) (distance p2 p1))
  182.                     )
  183.                 )
  184.            )
  185.       )
  186.     )
  187.     (setq trl (trianglst ptlst))
  188.     (vl-some (function
  189.                (lambda (x)
  190.                  (ptinsidetriangle-p pt (car x) (cadr x) (caddr x))
  191.                )
  192.              )
  193.              trl
  194.     )
  195.   )
  196.   (defun mid (p1 p2)
  197.     (mapcar (function (lambda (a b) (/ (+ a b) 2.0))) p1 p2)
  198.   )
  199.   (vla-startundomark
  200.     (setq adoc (vla-get-activedocument (vlax-get-acad-object)))
  201.   )
  202.   (setq spc (vla-get-block (vla-get-activelayout adoc)))
  203.   (if (not (tblsearch "DIMSTYLE" "SCAPE Standard"))
  204.     (Alert "SCAPE Standard dimension style not loaded")
  205.     (Command "-dimstyle" "r" "SCAPE Standard")
  206.   )
  207.   (prompt "\nSelect closed POLYGONS...")
  208.   (setq        sel (ssget (list '(0 . "LWPOLYLINE") '(-4 . "&=")
  209.                          '(70 . 1)             '(-4 . "<not")
  210.                          '(-4 . "<>")             '(42 . 0.0)
  211.                          '(-4 . "not>")
  212.                         )
  213.             )
  214.   )
  215.   (initget 7)
  216.   (setq        d (getdist
  217.             "\nPick or specify offset distance for dimensioning : "
  218.           )
  219.   )
  220.   (if sel
  221.     (progn
  222.       (repeat (setq i (sslength sel))
  223.         (setq lw (ssname sel (setq i (1- i))))
  224.         (setq enx (entget lw))
  225.         (setq
  226.           pl (mapcar
  227.                (function
  228.                  (lambda (x)
  229.                    (trans (list (car x) (cadr x) (cdr (assoc 38 enx)))
  230.                           lw
  231.                           1
  232.                    )
  233.                  )
  234.                )
  235.                (mapcar (function cdr)
  236.                        (vl-remove-if
  237.                          (function (lambda (x) (/= (car x) 10)))
  238.                          enx
  239.                        )
  240.                )
  241.              )
  242.         )
  243.         (vla-offset (vlax-ename->vla-object lw) d)
  244.         (setq lwn (entlast))
  245.         (setq enxn (entget lwn))
  246.         (setq plni
  247.                (mapcar
  248.                  (function
  249.                    (lambda (x)
  250.                      (trans (list (car x) (cadr x) (cdr (assoc 38 enxn)))
  251.                             lwn
  252.                             1
  253.                      )
  254.                    )
  255.                  )
  256.                  (mapcar (function cdr)
  257.                          (vl-remove-if
  258.                            (function (lambda (x) (/= (car x) 10)))
  259.                            enxn
  260.                          )
  261.                  )
  262.                )
  263.         )
  264.         (if (not (mr_IsPointInside (car plni) pl))
  265.           (progn (entdel lwn)
  266.                  (vla-offset (vlax-ename->vla-object lw) (- d))
  267.                  (setq lwn (entlast))
  268.                  (setq enxn (entget lwn))
  269.                  (setq plni
  270.                         (mapcar
  271.                           (function
  272.                             (lambda (x)
  273.                               (trans
  274.                                 (list (car x) (cadr x) (cdr (assoc 38 enxn)))
  275.                                 lwn
  276.                                 1
  277.                               )
  278.                             )
  279.                           )
  280.                           (mapcar (function cdr)
  281.                                   (vl-remove-if
  282.                                     (function (lambda (x) (/= (car x) 10)))
  283.                                     enxn
  284.                                   )
  285.                           )
  286.                         )
  287.                  )
  288.           )
  289.         )
  290.         (entdel lwn)
  291.         (setq
  292.           plno (mapcar
  293.                  (function
  294.                    (lambda (a b)
  295.                      (mapcar (function +) a (mapcar (function -) a b))
  296.                    )
  297.                  )
  298.                  pl
  299.                  plni
  300.                )
  301.         )
  302.         (setq plnom
  303.                (mapcar (function (lambda (a b) (mid a b)))
  304.                        plno
  305.                        (cdr (reverse (cons (car plno) (reverse plno))))
  306.                )
  307.         )
  308.         (mapcar        (function (lambda (a b c)
  309.                             (vla-addDimAligned
  310.                               spc
  311.                               (vlax-3d-point a)
  312.                               (vlax-3d-point b)
  313.                               (vlax-3d-point c)
  314.                             )
  315.                           )
  316.                 )
  317.                 pl
  318.                 (cdr (reverse (cons (car pl) (reverse pl))))
  319.                 plnom
  320.         )
  321.         (setq pl (reverse (cons (car pl) (reverse pl))))
  322.         (setq
  323.           plm (mapcar (function (lambda (a b) (mid a b))) pl (cdr pl))
  324.         )
  325.         (mapcar        (function (lambda (a b c d)
  326.                             (vla-AddDim3PointAngular
  327.                               spc
  328.                               (vlax-3d-point a)
  329.                               (vlax-3d-point b)
  330.                               (vlax-3d-point c)
  331.                               (vlax-3d-point d)
  332.                             )
  333.                           )
  334.                 )
  335.                 (cdr pl)
  336.                 plm
  337.                 (cdr (reverse (cons (car plm) (reverse plm))))
  338.                 (cdr (reverse (cons (car plni) (reverse plni))))
  339.         )
  340.       )
  341.     )
  342.     (prompt
  343.       "\nEmpty sel. set... Retry routine with valid sel. set..."
  344.     )
  345.   )
  346.   (*error* nil)
  347.   (setvar "CLAYER" clr)
  348.   (princ)
  349. )

函数 mr_IsPointInside:

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

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

已领礼包: 2107个

财富等级: 金玉满堂

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

使用道具 举报

已领礼包: 1387个

财富等级: 财源广进

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

使用道具 举报

已领礼包: 2476个

财富等级: 金玉满堂

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

使用道具 举报

已领礼包: 2409个

财富等级: 金玉满堂

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

使用道具 举报

已领礼包: 8710个

财富等级: 富甲天下

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

使用道具 举报

已领礼包: 496个

财富等级: 日进斗金

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

使用道具 举报

已领礼包: 496个

财富等级: 日进斗金

发表于 2017-7-25 12:52:53 | 显示全部楼层
本帖最后由 fangmin723 于 2017-7-25 12:55 编辑

隐藏的函数应该放在哪???

命令: dimpolygons ((nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil)
(nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil
nil) (nil nil nil))
命令:
命令: dimpolygons ((nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil
nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil)
(nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil nil) (nil nil
nil) (nil nil nil) (nil nil nil))




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

使用道具 举报

已领礼包: 769个

财富等级: 财运亨通

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

使用道具 举报

已领礼包: 475个

财富等级: 日进斗金

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

使用道具 举报

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

使用道具 举报

已领礼包: 26个

财富等级: 恭喜发财

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

使用道具 举报

已领礼包: 934个

财富等级: 财运亨通

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

使用道具 举报

已领礼包: 303个

财富等级: 日进斗金

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

使用道具 举报

已领礼包: 432个

财富等级: 日进斗金

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2024-3-29 03:54 , Processed in 0.434087 second(s), 59 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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