如何批量标注

429014673 · 发表于 2013-12-12 19:35:23

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

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

×

本帖最后由 429014673 于 2013-12-12 19:36 编辑

QQ截图20131212193601.png

求一独立程序源码
如上图，如何批量标注：众多基准点（块）的插入点到一基准线的垂直距离标注

Free-Lancer · 发表于 2013-12-12 21:27:40

为什么要独立程序呢?

(defun c:tt (/ e ss i e1 el ms an an1)
(vl-load-com)
(if (and (setq e (car (entsel "\nPick Line: ")))
(= (cdr (assoc 0 (entget e))) "LINE")
(setq ss (ssget '((0 . "INSERT"))))
)
(progn
(setq i -1
ms (vla-get-modelspace
(vla-get-activedocument (vlax-get-acad-object))
)
an (angle (vlax-curve-getstartpoint e)
(vlax-curve-getendpoint e)
)
an1 (+ an (* pi 0.5))
)
(while (setq e1 (ssname ss (setq i (1+ i))))
(setq el (cons (cdr (assoc 10 (entget e1))) el))
)
(mapcar
'(lambda (x)
(vla-AddDimRotated
ms
(vlax-3d-point (car x))
(vlax-3d-point (cadr x))
(vlax-3d-point (polar (cadr x) an 6.))
an1
)
)
(mapcar
'(lambda (p)
(list p
(vlax-curve-getclosestpointto e p)
)
)
el
)
)
)
)
(princ)
)

(defun c:tt (/ e ss i e1 el ms an an1) 
  (vl-load-com) 
  (if (and (setq e (car (entsel "\nPick Line: "))) 
           (= (cdr (assoc 0 (entget e))) "LINE") 
           (setq ss (ssget '((0 . "INSERT")))) 
      ) 
    (progn 
      (setq i        -1 
            ms        (vla-get-modelspace 
                  (vla-get-activedocument (vlax-get-acad-object)) 
                ) 
            an        (angle (vlax-curve-getstartpoint e) 
                       (vlax-curve-getendpoint e) 
                ) 
            an1        (+ an (* pi 0.5)) 
      ) 
      (while (setq e1 (ssname ss (setq i (1+ i)))) 
        (setq el (cons (cdr (assoc 10 (entget e1))) el)) 
      ) 
      (mapcar 
        '(lambda (x) 
           (vla-AddDimRotated 
             ms 
             (vlax-3d-point (car x)) 
             (vlax-3d-point (cadr x)) 
             (vlax-3d-point (polar (cadr x) an 6.)) 
             an1 
           ) 
         ) 
        (mapcar 
          '(lambda (p) 
             (list p 
                   (vlax-curve-getclosestpointto e p) 
             ) 
           ) 
          el 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

Free-Lancer · 发表于 2013-12-12 22:45:06

本帖最后由 Free-Lancer 于 2013-12-12 22:47 编辑

用 a/vlisp 就这样写，用到的函数在附件中(fas)

(defun c:tt (/ e an an1)
(vl-load-com)
(fy:begin)
(if (and (setq e (car (entsel "\nPick Line: ")))
(= (cdr (assoc 0 (entget e))) "LINE")
(ssget '((0 . "INSERT")))
)
(progn
(setq an (vlax-get (e2o e) 'Angle)
an1 (+ an _pi2)
)
(mapcar
'(lambda (x)
(vla-AddDimRotated
(fy:acms)
(vlax-3d-point (car x))
(vlax-3d-point (cadr x))
(vlax-3d-point (polar (cadr x) an 6.))
an1
)
)
(mapcar
'(lambda (x / p)
(setq p (vlax-get x 'Insertionpoint))
(list p
(vlax-curve-getclosestpointto e p)
)
)
(fy:cset->objs)
)
)
)
)
(fy:end)
(princ)
)

(defun c:tt (/ e an an1) 
  (vl-load-com) 
  (fy:begin) 
  (if (and (setq e (car (entsel "\nPick Line: "))) 
           (= (cdr (assoc 0 (entget e))) "LINE") 
           (ssget '((0 . "INSERT"))) 
      ) 
    (progn 
      (setq an        (vlax-get (e2o e) 'Angle) 
            an1        (+ an _pi2) 
      ) 
      (mapcar 
        '(lambda (x) 
           (vla-AddDimRotated 
             (fy:acms) 
             (vlax-3d-point (car x)) 
             (vlax-3d-point (cadr x)) 
             (vlax-3d-point (polar (cadr x) an 6.)) 
             an1 
           ) 
         ) 
        (mapcar 
          '(lambda (x / p) 
             (setq p (vlax-get x 'Insertionpoint)) 
             (list p 
                   (vlax-curve-getclosestpointto e p) 
             ) 
           ) 
          (fy:cset->objs) 
        ) 
      ) 
    ) 
  ) 
  (fy:end) 
  (princ) 
)

st788796 · 发表于 2013-12-13 08:36:33

不如用用 API，省去中间转换，面向对象，可以随手写

(defun c:tt (/ e ss an an1)
(if (and (setq e (car (xdrx_entsel "\n选择直线: " '((0 . "Line")))))
(progn
(princ "\n选择图块....")
(setq ss (ssget '((0 . "INSERT"))))
)
)
(progn
(setq an (xdrx_getpropertyvalue e "Angle")
an1 (+ an (* pi 0.5))
)
(mapcar
'(lambda (x)
(xdrx_dimension_makerotate
(car x)
(cadr x)
(polar (cadr x) an 6.)
an1
)
)
(mapcar
'(lambda (e1 / p)
(setq p (xdrx_getpropertyvalue e1 "Position"))
(list p
(vlax-curve-getclosestpointto e p)
)
)
(xdrx_pickset->ents ss)
)
)
)
)
(princ)
)

(defun c:tt (/ e ss an an1) 
  (if (and (setq e (car (xdrx_entsel "\n选择直线: " '((0 . "Line"))))) 
           (progn 
             (princ "\n选择图块....") 
             (setq ss (ssget '((0 . "INSERT")))) 
           ) 
      ) 
    (progn 
      (setq an        (xdrx_getpropertyvalue e "Angle") 
            an1        (+ an (* pi 0.5)) 
      ) 
      (mapcar 
        '(lambda (x) 
           (xdrx_dimension_makerotate 
             (car x) 
             (cadr x) 
             (polar (cadr x) an 6.) 
             an1 
           ) 
         ) 
        (mapcar 
          '(lambda (e1 / p) 
             (setq p (xdrx_getpropertyvalue e1 "Position")) 
             (list p 
                   (vlax-curve-getclosestpointto e p) 
             ) 
           ) 
          (xdrx_pickset->ents ss) 
        ) 
      ) 
    ) 
  ) 
  (princ) 
)

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

[求助] 如何批量标注

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

相关帖子

评分

评分