任意四边形，标注辅助线尺寸，列出公式。求帮忙，谢谢啦

hhaoma · 发表于 2014-8-26 21:10

本帖最后由 Gu_xl 于 2014-8-26 21:41 编辑

目标是对于任意四边形，会自动做辅助线并自动标注尺寸接着自动列出公式
目前代码已经实现做辅助线（感谢cad高手：q2 的无私奉献）

(defun c:tt ( / a b e l l1 l2 p pt1 pt2 pts px x y)
(vl-load-com)
(defun gpts (e) (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget e))))
(defun mkline (pt1 pt2) (entmakex (list '(0 . "LINE") (cons 10 pt1) (cons 11 pt2))))
(setq p (getpoint))
(vl-cmdf "bpoly" p "")
(setq e (entlast)
pts (gpts e)
l (list (list (car pts) (caddr pts)) (list (cadr pts) (cadddr pts)))
l (vl-sort l '(lambda (x y) (> (distance (car x) (cadr x)) (distance (car y) (cadr y))) ) )
l1 (car l)
l2 (cadr l)
a (mkline (car l1) (cadr l1))
b (mkline (setq px (car l2)) (vlax-curve-getClosestPointTo a px))
b (mkline (setq px (cadr l2)) (vlax-curve-getClosestPointTo a px))
)
(entdel e)
)

edata · 发表于 2014-8-26 21:10

本帖最后由 edata 于 2014-8-30 16:38 编辑

(defun c:tt(/ ss lst en ANGH1 ANGH2 ANGW1A ANGW1B ANGW2A ANGW2B
H1 H2 P1 P2 P2C P3 P4 P4C PTH1 PTH2 PTW1A PTW1B PTW2A PTW2B STR1 TXTPT W1A W1B W2A W2B)
(or font_hh (setq font_hh 2.5))
(setq font_hh(cond((getdist (strcat "\n输入文字高度<"(rtos font_hh 2 2) ">:")))(font_hh)))
(if(setq ss(ssget '((0 . "LWPOLYLINE"))))
(while(setq en(ssname ss 0))
(redraw en 3)
(setq lst(mapcar 'cdr (vl-remove-if-not ''((x)(= (car x) 10)) (entget en))))
(mapcar 'set '(p1 p2 p3 p4) lst)
(setq p2c(PerToLine p2 p1 p3)
p4c(PerToLine p4 p1 p3)
w1a(distance p1 p4c)
h1(distance p4c p4)
w1b(distance p4c p3)
w2a(distance p2c p1)
h2(distance p2c p2)
w2b(distance p2c p3)
angw1a(angle p1 p4c)
angh1(angle p4c p4)
angw1b(angle p4c p3)
angw2a(angle p2c p1)
angh2(angle p2c p2)
angw2b(angle p3 p2c)
ptw1a(polar (sk_m2p p1 p4c) (+ angw1a (* pi 0.5)) (* font_hh 0.25))
pth1(polar (sk_m2p p4c p4) (+ angh1 (* pi 0.5))(* font_hh 0.25))
ptw1b(polar (sk_m2p p4c p3) (+ angw1b (* pi 0.5)) (* font_hh 0.25))
ptw2a(polar (sk_m2p p2c p1) (+ angw2a (* pi 0.5)) (* font_hh 0.25))
pth2(polar (sk_m2p p2c p2)(+ angh2 (* pi 0.5)) (* font_hh 0.25))
ptw2b(polar (sk_m2p p2c p3) (+ angw2b (* pi 0.5)) (* font_hh 0.25))
)
(entmake (list '(0 . "line")(cons 10 p1)(cons 11 p3)))
(entmake (list '(0 . "line")(cons 10 p2)(cons 11 p2c)))
(entmake (list '(0 . "line")(cons 10 p4)(cons 11 p4c)))
(entmake (list '(0 . "TEXT")
(cons 1 (rtos w1a 2 2))
(cons 73 (if (and (< angw1a (* pi 1.5))(> angw1a (* pi 0.5))) 3 0))
(cons 72 1)
(cons 10 ptw1a)
(cons 11 ptw1a)
(cons 40 font_hh)
(cons 50 (if (and (< angw1a (* pi 1.5))(> angw1a (* pi 0.5))) (+ angw1a pi) angw1a))
)
)
(entmake (list '(0 . "TEXT")
(cons 1 (rtos h1 2 2))
(cons 73 (if (and (< angh1 (* pi 1.5))(> angh1 (* pi 0.5))) 3 0))
(cons 72 1)
(cons 10 pth1)
(cons 11 pth1)
(cons 40 font_hh)
(cons 50 (if (and (< angh1 (* pi 1.5))(> angh1 (* pi 0.5))) (+ angh1 pi) angh1))
)
)
(entmake (list '(0 . "TEXT")
(cons 1 (rtos w1b 2 2))
(cons 73 (if (and (< angw1b (* pi 1.5))(> angw1b (* pi 0.5))) 3 0))
(cons 72 1)
(cons 10 ptw1b)
(cons 11 ptw1b)
(cons 40 font_hh)
(cons 50 (if (and (< angw1b (* pi 1.5))(> angw1b (* pi 0.5))) (+ angw1b pi) angw1b))
)
)
(entmake (list '(0 . "TEXT")
(cons 1 (rtos w2a 2 2))
(cons 73 (if (and (< angw2a (* pi 1.5))(> angw2a (* pi 0.5))) 3 0))
(cons 72 1)
(cons 10 ptw2a)
(cons 11 ptw2a)
(cons 40 font_hh)
(cons 50 (if (and (< angw2a (* pi 1.5))(> angw2a (* pi 0.5))) (+ angw2a pi) angw2a))
)
)
(entmake (list '(0 . "TEXT")
(cons 1 (rtos h2 2 2))
(cons 73 (if (and (< angh2 (* pi 1.5))(> angh2 (* pi 0.5))) 3 0))
(cons 72 1)
(cons 10 pth2)
(cons 11 pth2)
(cons 40 font_hh)
(cons 50 (if (and (< angh2 (* pi 1.5))(> angh2 (* pi 0.5))) (+ angh2 pi) angh2))
)
)
(entmake (list '(0 . "TEXT")
(cons 1 (rtos w2b 2 2))
(cons 73 (if (and (< angw2b (* pi 1.5))(> angw2b (* pi 0.5))) 3 0))
(cons 72 1)
(cons 10 ptw2b)
(cons 11 ptw2b)
(cons 40 font_hh)
(cons 50 (if (and (< angw2b (* pi 1.5))(> angw2b (* pi 0.5))) (+ angw2b pi) angw2b))
)
)
(setq str1(strcat "(" (rtos w1a 2 2) "+" (rtos w1b 2 2) ")*" (rtos h1 2 2)"/2+"
"(" (rtos w2a 2 2) "+" (rtos w2b 2 2) ")*" (rtos h2 2 2)"/2"))
(if(setq txtpt(getpoint "\n指定文字放置点:"))
(entmake (list '(0 . "TEXT") (cons 1 str1) (cons 10 txtpt)(cons 11 txtpt)(cons 72 1)(cons 73 2) (cons 40 font_hh)))
)
(redraw en 4)
(setq ss (ssdel en ss))
)
)
(princ)
)
(defun sk_m2p(p1 p2 / x y)(mapcar'(lambda(x y)(* 0.5 (+ x y))) p1 p2))
;;;计算cp到p1 p2的垂足点
(defun PerToLine (cp p1 p2 / norm)
(setq norm (mapcar '- p2 p1)
p1 (trans p1 0 norm)
cp (trans cp 0 norm)
)
(trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
)

(defun c:tt(/ ss lst en ANGH1 ANGH2 ANGW1A ANGW1B ANGW2A ANGW2B 
      H1 H2 P1 P2 P2C P3 P4 P4C PTH1 PTH2 PTW1A PTW1B PTW2A PTW2B STR1 TXTPT W1A W1B W2A W2B) 
  (or font_hh (setq font_hh 2.5)) 
  (setq font_hh(cond((getdist (strcat "\n输入文字高度<"(rtos font_hh 2 2) ">:")))(font_hh))) 
  (if(setq ss(ssget '((0 . "LWPOLYLINE"))))    
    (while(setq en(ssname ss 0)) 
      (redraw en 3) 
      (setq lst(mapcar 'cdr (vl-remove-if-not ''((x)(= (car x) 10)) (entget en)))) 
      (mapcar 'set '(p1 p2 p3 p4) lst) 
      (setq p2c(PerToLine p2 p1 p3) 
      p4c(PerToLine p4 p1 p3) 
      w1a(distance p1 p4c) 
      h1(distance p4c p4) 
      w1b(distance p4c p3) 
      w2a(distance p2c p1) 
      h2(distance p2c p2) 
      w2b(distance p2c p3) 
      angw1a(angle p1 p4c) 
      angh1(angle p4c p4) 
      angw1b(angle p4c p3) 
      angw2a(angle p2c p1) 
      angh2(angle p2c p2) 
      angw2b(angle p3 p2c)       
      ptw1a(polar (sk_m2p p1 p4c) (+ angw1a (* pi 0.5)) (* font_hh 0.25)) 
      pth1(polar (sk_m2p p4c p4) (+ angh1 (* pi 0.5))(* font_hh 0.25)) 
      ptw1b(polar (sk_m2p p4c p3) (+ angw1b (* pi 0.5)) (* font_hh 0.25)) 
      ptw2a(polar (sk_m2p p2c p1) (+ angw2a (* pi 0.5)) (* font_hh 0.25)) 
      pth2(polar (sk_m2p p2c p2)(+ angh2 (* pi 0.5)) (* font_hh 0.25)) 
      ptw2b(polar (sk_m2p p2c p3)  (+ angw2b (* pi 0.5)) (* font_hh 0.25)) 
      ) 
      (entmake (list '(0 . "line")(cons 10 p1)(cons 11 p3))) 
      (entmake (list '(0 . "line")(cons 10 p2)(cons 11 p2c))) 
      (entmake (list '(0 . "line")(cons 10 p4)(cons 11 p4c))) 
      (entmake (list '(0 . "TEXT") 
         (cons 1 (rtos w1a 2 2))          
         (cons 73 (if (and (< angw1a (* pi 1.5))(> angw1a (* pi 0.5))) 3 0)) 
         (cons 72 1) 
         (cons 10 ptw1a) 
         (cons 11 ptw1a) 
         (cons 40 font_hh) 
         (cons 50 (if (and (< angw1a (* pi 1.5))(> angw1a (* pi 0.5))) (+ angw1a pi) angw1a)) 
         ) 
      ) 
       
      (entmake (list '(0 . "TEXT") 
         (cons 1 (rtos h1 2 2))          
         (cons 73 (if (and (< angh1 (* pi 1.5))(> angh1 (* pi 0.5))) 3 0)) 
         (cons 72 1) 
         (cons 10 pth1) 
         (cons 11 pth1) 
         (cons 40 font_hh) 
         (cons 50 (if (and (< angh1 (* pi 1.5))(> angh1 (* pi 0.5))) (+ angh1 pi) angh1)) 
         ) 
      ) 
      (entmake (list '(0 . "TEXT") 
         (cons 1 (rtos w1b 2 2))          
         (cons 73 (if (and (< angw1b (* pi 1.5))(> angw1b (* pi 0.5))) 3 0)) 
         (cons 72 1) 
         (cons 10 ptw1b) 
         (cons 11 ptw1b) 
         (cons 40 font_hh) 
         (cons 50 (if (and (< angw1b (* pi 1.5))(> angw1b (* pi 0.5))) (+ angw1b pi) angw1b)) 
         ) 
      ) 
      (entmake (list '(0 . "TEXT") 
         (cons 1 (rtos w2a 2 2))          
         (cons 73 (if (and (< angw2a (* pi 1.5))(> angw2a (* pi 0.5))) 3 0)) 
         (cons 72 1) 
         (cons 10 ptw2a) 
         (cons 11 ptw2a) 
         (cons 40 font_hh) 
         (cons 50 (if (and (< angw2a (* pi 1.5))(> angw2a (* pi 0.5))) (+ angw2a pi) angw2a)) 
         ) 
      ) 
      (entmake (list '(0 . "TEXT") 
         (cons 1 (rtos h2 2 2))          
         (cons 73 (if (and (< angh2 (* pi 1.5))(> angh2 (* pi 0.5))) 3 0)) 
         (cons 72 1) 
         (cons 10 pth2) 
         (cons 11 pth2) 
         (cons 40 font_hh) 
         (cons 50 (if (and (< angh2 (* pi 1.5))(> angh2 (* pi 0.5))) (+ angh2 pi) angh2)) 
         ) 
      ) 
      (entmake (list '(0 . "TEXT") 
         (cons 1 (rtos w2b 2 2))          
         (cons 73 (if (and (< angw2b (* pi 1.5))(> angw2b (* pi 0.5))) 3 0)) 
         (cons 72 1) 
         (cons 10 ptw2b) 
         (cons 11 ptw2b) 
         (cons 40 font_hh) 
         (cons 50 (if (and (< angw2b (* pi 1.5))(> angw2b (* pi 0.5))) (+ angw2b pi) angw2b)) 
         ) 
      ) 
      (setq str1(strcat "(" (rtos w1a 2 2) "+" (rtos w1b 2 2) ")*" (rtos h1 2 2)"/2+" 
      "(" (rtos w2a 2 2) "+" (rtos w2b 2 2) ")*" (rtos h2 2 2)"/2")) 
      (if(setq txtpt(getpoint "\n指定文字放置点:")) 
  (entmake (list '(0 . "TEXT") (cons 1 str1) (cons 10 txtpt)(cons 11 txtpt)(cons 72 1)(cons 73 2) (cons 40 font_hh))) 
  ) 
      (redraw en 4) 
      (setq ss (ssdel en ss)) 
      )    
    ) 
  (princ) 
  ) 
(defun sk_m2p(p1 p2 / x y)(mapcar'(lambda(x y)(* 0.5 (+ x y))) p1 p2)) 
;;;计算cp到p1 p2的垂足点 
(defun PerToLine  (cp p1 p2 / norm) 
  (setq        norm (mapcar '- p2 p1) 
        p1   (trans p1 0 norm) 
        cp   (trans cp 0 norm) 
        ) 
  (trans (list (car p1) (cadr p1) (caddr cp)) norm 0) 
  )

linjian257 · 发表于 2014-8-26 22:02

hhaoma · 发表于 2014-8-26 22:11

linjian257 发表于 2014-8-26 22:02

只发图不发代码是要收费的吧？呵呵

hhaoma · 发表于 2014-8-26 22:13

厉害厉害！可惜没有代码啊，我也不能使用。求大神帮忙

ynhh · 发表于 2014-8-27 09:57

linjian257
果然很牛哈

flytoday · 发表于 2014-8-27 16:43

没实际意义。。。又是任意多边形才好~~

hhaoma · 发表于 2014-8-27 17:13

edata 发表于 2014-8-27 13:49

亲爱的大神，能共享一下源代码吗？

song宋_74729 · 发表于 2017-11-18 15:50

本帖最后由 song宋_74729 于 2017-11-18 15:57 编辑

edata 发表于 2014-8-26 21:10

标注参考线尺寸，列出公式平方米
麻烦老师　

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

[已解答] 任意四边形，标注辅助线尺寸，列出公式。求帮忙，谢谢啦

最佳答案

相关帖子

本帖子中包含更多资源

评分

本帖子中包含更多资源