hhaoma 发表于 2014-8-27 07:38:36

点击长方形内部，自动标注

本帖最后由 Gu_xl 于 2014-8-27 09:19 编辑

求大神帮忙看看，谢谢大神啊！

duotu007 发表于 2014-8-27 07:38:37

;为测试
(defun c:test ()
(setq pt (getpoint))
(setq en1 (entlast))
(vl-cmdf "boundary" "a" "o" "p" "" pt "")
(setq en (entlast))
(if (not (equal en1 en))
    (progn
      (setq enlst (entget en))
      (setq pts (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) enlst)))
      (setq dis1 (distance (nth 0 pts) (nth 1 pts)))
      (setq dis2 (distance (nth 1 pts) (nth 2 pts)))
      (setq pt1 (mapcar '* (mapcar '+ (nth 0 pts) (nth 1 pts)) '(0.5 0.5 0.5)))
      (setq pt2 (mapcar '* (mapcar '+ (nth 1 pts) (nth 2 pts)) '(0.5 0.5 0.5)))
      (entmakex
      (list (cons 0 "text")
          (cons 1 (rtos dis1 2 2))
          (cons 7 (getvar "textstyle"))
          (cons 40 3);字高
          (cons 10 pt1)
          (cons 11 pt1)
          (cons 72 1)
          (cons 73 2)
          (cons 8 "0")
      )
      )
      (entmakex
      (list (cons 0 "text")
          (cons 1 (rtos dis2 2 2))
          (cons 7 (getvar "textstyle"))
          (cons 40 3);字高
          (cons 10 pt2)
          (cons 11 pt2)
          (cons 72 1)
          (cons 73 2)
          (cons 8 "0")
      )
      )
      (entdel en)
    )
)
)

hhaoma 发表于 2014-8-27 12:24:41

duotu007 发表于 2014-8-27 07:38 static/image/common/back.gif
;为测试
(defun c:test ()
(setq pt (getpoint))


大神 你真厉害啊！！！还有两个问题 能再帮我看看不?
http://bbs.mjtd.com/forum.php?mod=viewthread&tid=111204&page=1#pid650054
http://bbs.mjtd.com/thread-111203-1-1.html

duotu007 发表于 2014-8-27 12:43:42

思路一样的，上面代码修改下就可以了。

hhaoma 发表于 2014-8-27 12:50:13

duotu007 发表于 2014-8-27 12:43 static/image/common/back.gif
思路一样的，上面代码修改下就可以了。

本人愚昧 不知道大神可有时间帮忙修改下呢？谢谢啊！

duotu007 发表于 2014-8-27 13:17:58

(defun c:test ()
(setq pt (getpoint))
(setq en1 (entlast))
(vl-cmdf "boundary" "a" "o" "p" "" pt "")
(setq en (entlast))
(if (not (equal en1 en))
    (progn
      (setq enlst (entget en))
      (setq pts (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) enlst)))
      (setq i 0)
      (repeat (length pts)
      (setq j (+ i 1))
      (if (> j (- (length pts) 1)) (setq j 0))
      (setq dis (distance (nth i pts) (nth j pts)))
      (setq pt1 (mapcar '* (mapcar '+ (nth i pts) (nth j pts)) '(0.5 0.5 0.5)))
      (entmakex
          (list (cons 0 "text")
            (cons 1 (rtos dis 2 2))
            (cons 7 (getvar "textstyle"))
            (cons 40 3);字高
            (cons 10 pt1)
            (cons 11 pt1)
            (cons 72 1)
            (cons 73 2)
            (cons 8 "0")
          )
      )
      (setq i (+ i 1))
      )
      (entdel en)
    )
)
)
；把所有的边长都写出来了

hhaoma 发表于 2014-8-27 13:34:15

duotu007 发表于 2014-8-27 13:17 static/image/common/back.gif
(defun c:test ()
(setq pt (getpoint))
(setq en1 (entlast))

请问大神 能把边长的文本格式改成dim标注的形式不？
我想把标注标在下边和右边的内部（如图所示） 有办法修改不？

duotu007 发表于 2014-8-27 14:08:49

(defun c:test ()
(setq pt (getpoint))
(setq en1 (entlast))
(vl-cmdf "boundary" "a" "o" "p" "" pt "")
(setq en (entlast))
(setq cdim (tblsearch "dimstyle" (getvar "dimstyle")))
(setq txthi (* (cdr (assoc 140 cdim)) (cdr (assoc 40 cdim))))
(if (not (equal en1 en))
    (progn
      (setq enlst (entget en))
      (setq pts (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) enlst)))
      (setq i 0)
      (repeat (length pts)
      (setq j (+ i 1))
      (if (> j (- (length pts) 1)) (setq j 0))
      (setq pt (polar (nth j pts) (- (angle (nth i pts) (nth j pts)) (/ pi 2)) (* txthi 2)))
      (entmakex
          (list
            '(0 . "DIMENSION") '(100 . "AcDbEntity") '(100 . "AcDbDimension")
            (cons 10 pt) (cons 3 (getvar "dimstyle")) (cons 8 "0") '(70 . 33) '(1 . "") '(100 . "AcDbAlignedDimension")
            (cons 13 (nth i pts)) (cons 14 (nth j pts))
          )
      )
      (setq i (+ i 1))
      )
      (entdel en)
    )
)
)

1993063 发表于 2014-8-27 15:33:23

duotu007 发表于 2014-8-26 20:08 static/image/common/back.gif
(defun c:test ()
(setq pt (getpoint))
(setq en1 (entlast))


高手

bai2000 发表于 2014-8-27 16:55:22

本帖最后由 bai2000 于 2014-8-27 16:58 编辑

能不能改改，能控制字体高度？还能连续标注？
页: [1]
查看完整版本: 点击长方形内部，自动标注