设为首页收藏本站

晓东CAD家园-论坛

 找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

楼主: Lisphk

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

  [复制链接]

已领礼包: 393个

财富等级: 日进斗金

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

使用道具 举报

已领礼包: 393个

财富等级: 日进斗金

发表于 2020-4-8 07:13:30 | 显示全部楼层
不能使用啊,括号不匹配?谁有修好的代码?麻烦上传一下呗
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

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

使用道具 举报

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

使用道具 举报

已领礼包: 41个

财富等级: 招财进宝

发表于 2020-5-20 23:18:22 | 显示全部楼层

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

使用道具 举报

已领礼包: 393个

财富等级: 日进斗金

发表于 2020-5-21 10:21:13 | 显示全部楼层
我拷贝程序后,括号不匹配啊,没有遇到这个问题的吗?谁有完整的代码?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 393个

财富等级: 日进斗金

发表于 2020-5-21 11:24:25 | 显示全部楼层
(defun c:dimpolygons ( / *error* mr_IsPointInside mid adoc spc sel d i lw enx pl lwn enxn plni plno plnom plm clr)

  (vl-load-com)

  (defun *error* ( m )
    (vla-endundomark adoc)
    (if m
      (prompt m)
    )
    (princ)
  )

(setq clr (getvar "CLAYER"))
(command "-layer" "Make" "0-Dims" "color" "3" "" "")

  (defun mr_IsPointInside ( pt ptlst / trianglst ptinsidetriangle-p trl )

    (defun trianglst ( ptlst / unique LM:ListClockwise-p clockwise-p l p1 p2 p3 trl )

      (defun unique ( l )
        (if l (cons (car l) (unique (vl-remove-if (function (lambda ( x ) (equal x (car l) 1e-6))) l))))
      )

      ;; List Clockwise-p - Lee Mac
      ;; Returns T if the point list is clockwise oriented

      (defun LM:ListClockwise-p ( lst )
        (minusp
          (apply '+
            (mapcar
              (function
                (lambda ( a b )
                  (- (* (car b) (cadr a)) (* (car a) (cadr b)))
                )
              )
              lst (cons (last lst) lst)
            )
          )
        )
      )

      (defun clockwise-p ( p1 p2 p3 )
        (< (* (- (car  p2) (car  p1)) (- (cadr p3) (cadr p1)))
           (* (- (cadr p2) (cadr p1)) (- (car  p3) (car  p1)))
        )
      )

      (setq l ptlst)
      (while (> (length ptlst) 3)
        (setq p1 (car ptlst) p2 (cadr ptlst) p3 (caddr ptlst))
        (cond
          ( (LM:ListClockwise-p ptlst)
            (if
              (and
                (clockwise-p p1 p2 p3)
                (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p1 p2 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
                (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p2 p3 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
                (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p3 p1 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
              )
              (progn
                (setq trl (cons (list p1 p2 p3) trl))
                (setq ptlst (vl-remove p2 ptlst))
                (setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
              )
              (setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
            )
          )
          ( (not (LM:ListClockwise-p ptlst))
            (if
              (and
                (not (clockwise-p p1 p2 p3))
                (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p1 p2 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
                (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p2 p3 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
                (= (length (unique (vl-remove nil (mapcar (function (lambda ( a b ) (inters p3 p1 a b))) l (cdr (reverse (cons (car l) (reverse l)))))))) 2)
              )
              (progn
                (setq trl (cons (list p1 p2 p3) trl))
                (setq ptlst (vl-remove p2 ptlst))
                (setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
              )
              (setq ptlst (cdr (reverse (cons (car ptlst) (reverse ptlst)))))
            )
          )
        )
      )
      (setq trl (cons (list (car ptlst) (cadr ptlst) (caddr ptlst)) trl))
      trl
    )

    (defun ptinsidetriangle-p ( pt p1 p2 p3 )
      (and
        (not
          (or
            (inters pt p1 p2 p3)
            (inters pt p2 p1 p3)
            (inters pt p3 p1 p2)
          )
        )
        (not
          (or
            (> (+ (distance pt p1) (distance pt p2)) (+ (distance p3 p1) (distance p3 p2)))
            (> (+ (distance pt p2) (distance pt p3)) (+ (distance p1 p2) (distance p1 p3)))
            (> (+ (distance pt p3) (distance pt p1)) (+ (distance p2 p3) (distance p2 p1)))
          )
        )
      )
    )

    (setq trl (trianglst ptlst))
    (vl-some (function (lambda ( x ) (ptinsidetriangle-p pt (car x) (cadr x) (caddr x)))) trl)
  )

  (defun mid ( p1 p2 )
    (mapcar (function (lambda ( a b ) (/ (+ a b) 2.0))) p1 p2)
  )

  (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
  (setq spc (vla-get-block (vla-get-activelayout adoc)))
  (if (not (tblsearch "DIMSTYLE" "SCAPE Standard"))
    (Alert "SCAPE Standard dimension style not loaded")
    (Command "-dimstyle" "r" "SCAPE Standard")
  )
  (prompt "\nSelect closed POLYGONS...")
  (setq sel (ssget (list '(0 . "LWPOLYLINE") '(-4 . "&=") '(70 . 1) '(-4 . "<not") '(-4 . "<>") '(42 . 0.0) '(-4 . "not>"))))
  (initget 7)
  (setq d (getdist "\nPick or specify offset distance for dimensioning : "))
  (if sel
    (progn
      (repeat (setq i (sslength sel))
        (setq lw (ssname sel (setq i (1- i))))
        (setq enx (entget lw))
        (setq pl (mapcar (function (lambda ( x ) (trans (list (car x) (cadr x) (cdr (assoc 38 enx))) lw 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) enx))))
        (vla-offset (vlax-ename->vla-object lw) d)
        (setq lwn (entlast))
        (setq enxn (entget lwn))
        (setq plni (mapcar (function (lambda ( x ) (trans (list (car x) (cadr x) (cdr (assoc 38 enxn))) lwn 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) enxn))))
        (if (not (mr_IsPointInside (car plni) pl))
          (progn
            (entdel lwn)
            (vla-offset (vlax-ename->vla-object lw) (- d))
            (setq lwn (entlast))
            (setq enxn (entget lwn))
            (setq plni (mapcar (function (lambda ( x ) (trans (list (car x) (cadr x) (cdr (assoc 38 enxn))) lwn 1))) (mapcar (function cdr) (vl-remove-if (function (lambda ( x ) (/= (car x) 10))) enxn))))
          )
        )
        (entdel lwn)
        (setq plno (mapcar (function (lambda ( a b ) (mapcar (function +) a (mapcar (function -) a b)))) pl plni))
        (setq plnom (mapcar (function (lambda ( a b ) (mid a b))) plno (cdr (reverse (cons (car plno) (reverse plno))))))
        (mapcar (function (lambda ( a b c ) (vla-addDimAligned spc (vlax-3d-point a) (vlax-3d-point b) (vlax-3d-point c)))) pl (cdr (reverse (cons (car pl) (reverse pl)))) plnom)
        (setq pl (reverse (cons (car pl) (reverse pl))))
        (setq plm (mapcar (function (lambda ( a b ) (mid a b))) pl (cdr pl)))
        (mapcar (function (lambda ( a b c d ) (vla-AddDim3PointAngular spc (vlax-3d-point a) (vlax-3d-point b) (vlax-3d-point c) (vlax-3d-point d)))) (cdr pl) plm (cdr (reverse (cons (car plm) (reverse plm)))) (cdr (reverse (cons (car plni) (reverse plni)))))
      )
    )
    (prompt "\nEmpty sel. set... Retry routine with valid sel. set...")
  )
  (*error* nil)
(setvar "CLAYER" clr)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 1个

财富等级: 恭喜发财

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

使用道具 举报

已领礼包: 3个

财富等级: 恭喜发财

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

使用道具 举报

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

使用道具 举报

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

使用道具 举报

已领礼包: 4个

财富等级: 恭喜发财

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

使用道具 举报

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

使用道具 举报

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

使用道具 举报

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

使用道具 举报

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

本版积分规则

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

GMT+8, 2020-11-30 01:06 , Processed in 0.194474 second(s), 89 queries , Gzip On, WinCache On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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