标注多段线各边长度及夹角

Lisphk · 发表于 2017-7-25 11:35:19

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

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

×

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

(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" "" "")
;; 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)
(princ)
)

(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" "" "") 
      ;; 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) 
  (princ) 
)

函数 mr_IsPointInside：

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

evayleung · 发表于 2017-7-25 11:47:56

好东西就得支持一下，谢谢分享

向嘟嘟 · 发表于 2017-7-25 11:50:12

看看。。。。。。。

q3_2006 · 发表于 2017-7-25 12:05:23

这个幕墙用得多...

zjy2999 · 发表于 2017-7-25 12:16:08

xuexi!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

yoyoho · 发表于 2017-7-25 12:41:51

回覆学习，谢谢分享！！！

fangmin723 · 发表于 2017-7-25 12:42:43

谢谢大神分享！！！

fangmin723 · 发表于 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))

sh_h · 发表于 2017-7-25 13:12:01

好好学习一下，谢谢楼主分享！！！

laiz3000 · 发表于 2017-7-25 13:12:23

回复学习一下

iszc · 发表于 2017-7-25 13:32:39

好东西就得支持一下，谢谢分享

zixuan203344 · 发表于 2017-7-25 14:09:17

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

tengteb · 发表于 2017-7-25 14:18:20

不错，标记一下！

yaokui25 · 发表于 2017-7-25 14:28:41

好东西就得支持一下，谢谢分享

qhdycm2016 · 发表于 2017-7-25 14:43:16

我来测试一下，行不行

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

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

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