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

hhaoma

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

duotu007

;为测试
(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

duotu007 发表于 2014-8-27 07:38
;为测试
(defun c:test ()
  (setq pt (getpoint))

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

duotu007

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

hhaoma

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

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

duotu007

(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

duotu007 发表于 2014-8-27 13:17
(defun c:test ()
  (setq pt (getpoint))
  (setq en1 (entlast))

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

duotu007

(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

duotu007 发表于 2014-8-26 20:08
(defun c:test ()
  (setq pt (getpoint))
  (setq en1 (entlast))

高手

bai2000

能不能改改，能控制字体高度？还能连续标注？