[求助]：如何做到框选这些标注后就生成下面红色的标注?

userzhluserzhl · 发表于 2009-3-22 19:19:21

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

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

×

如何做到框选这些标注后就生成下面红色的标注?

xuyu · 发表于 2009-3-22 19:31:35

你是指自动合并尺寸并另标注吗

kmdz · 发表于 2009-3-22 21:33:02

思路：复制选集中的一个标注，提取选集的13，14成表，移除13和14相同的项，得到新标注的两个端点，修改复制的那个标注定义数据。标注位置可以自己指定，也可由程序自行计算位置。

(vl-load-com)
(defun c:t1 ()
(defun *error* (msg)
(print msg)
(print "\n检查标注是否都在一条线上或有重合?")
(entdel (entlast))
(setq *error* nil
dim-dxf-lst
nil
)
)
(while (and
(not (prompt "\n选择需要累加的标注:"))
(setq dim-ss (ssget '((0 . "DIMENSION") (1 . ""))))
(> (setq dim-ss-n (sslength dim-ss)) 1)
(vl-cmdf "copy" (ssname dim-ss 0) "" '(0 0) '(0 0))
(setq
dim-dxf-14 (cdr (assoc 14 (entget (ssname dim-ss 0))))
dim-dxf-10 (cdr (assoc 10 (entget (ssname dim-ss 0))))
dim-dis-1410 (distance dim-dxf-14 dim-dxf-10)
dim-ang-1410 (angle dim-dxf-14 dim-dxf-10)
dim-dxf-10 (polar dim-dxf-10
dim-ang-1410
(* dim-dis-1410 (1- dim-ss-n))
)
)
)
(if (setq tmp (getpoint "\n指定尺寸标注位置:"))
(setq dim-dxf-10 tmp)
)
(setq dim-dxf-lst nil)
(repeat dim-ss-n
(setq dim-dxf-lst
(append
(list
(cdr
(assoc
13
(entget (ssname dim-ss (setq dim-ss-n (1- dim-ss-n))))
)
)
(cdr (assoc 14 (entget (ssname dim-ss dim-ss-n))))
)
dim-dxf-lst
)
)
)
(foreach m dim-dxf-lst
(setq i 0)
(foreach n dim-dxf-lst
(if (equal m n)
(if (> (setq i (1+ i)) 1)
(setq dim-dxf-lst (vl-remove m dim-dxf-lst))
)
)
)
)
(setq dim-ent (entget (entlast))
dim-ent (subst (cons 13 (nth 0 dim-dxf-lst))
(assoc 13 dim-ent)
dim-ent
)
dim-ent (subst (cons 14 (nth 1 dim-dxf-lst))
(assoc 14 dim-ent)
dim-ent
)
dim-ent (subst (cons 10 dim-dxf-10) (assoc 10 dim-ent) dim-ent)
)
(entmod dim-ent)
)
)

(vl-load-com) 
(defun c:t1 () 
  (defun *error* (msg) 
    (print msg) 
    (print "\n检查标注是否都在一条线上或有重合?") 
    (entdel (entlast)) 
    (setq *error* nil 
          dim-dxf-lst 
           nil 
    ) 
  ) 
  (while (and 
           (not (prompt "\n选择需要累加的标注:")) 
           (setq dim-ss (ssget '((0 . "DIMENSION") (1 . "")))) 
           (> (setq dim-ss-n (sslength dim-ss)) 1) 
           (vl-cmdf "copy" (ssname dim-ss 0) "" '(0 0) '(0 0)) 
           (setq 
             dim-dxf-14          (cdr (assoc 14 (entget (ssname dim-ss 0)))) 
             dim-dxf-10          (cdr (assoc 10 (entget (ssname dim-ss 0)))) 
             dim-dis-1410 (distance dim-dxf-14 dim-dxf-10) 
             dim-ang-1410 (angle dim-dxf-14 dim-dxf-10) 
             dim-dxf-10          (polar dim-dxf-10 
                                 dim-ang-1410 
                                 (* dim-dis-1410 (1- dim-ss-n)) 
                          ) 
           ) 
         ) 
    (if        (setq tmp (getpoint "\n指定尺寸标注位置:")) 
      (setq dim-dxf-10 tmp) 
    ) 
    (setq dim-dxf-lst nil) 
    (repeat dim-ss-n 
      (setq dim-dxf-lst 
             (append 
               (list 
                 (cdr 
                   (assoc 
                     13 
                     (entget (ssname dim-ss (setq dim-ss-n (1- dim-ss-n)))) 
                   ) 
                 ) 
                 (cdr (assoc 14 (entget (ssname dim-ss dim-ss-n)))) 
               ) 
               dim-dxf-lst 
             ) 
      ) 
    ) 
    (foreach m dim-dxf-lst 
      (setq i 0) 
      (foreach n dim-dxf-lst 
        (if (equal m n) 
          (if (> (setq i (1+ i)) 1) 
            (setq dim-dxf-lst (vl-remove m dim-dxf-lst)) 
          ) 
        ) 
      ) 
    ) 
    (setq dim-ent (entget (entlast)) 
          dim-ent (subst (cons 13 (nth 0 dim-dxf-lst)) 
                         (assoc 13 dim-ent) 
                         dim-ent 
                  ) 
          dim-ent (subst (cons 14 (nth 1 dim-dxf-lst)) 
                         (assoc 14 dim-ent) 
                         dim-ent 
                  ) 
          dim-ent (subst (cons 10 dim-dxf-10) (assoc 10 dim-ent) dim-ent) 
    ) 
    (entmod dim-ent) 
  ) 
)

userzhluserzhl · 发表于 2009-3-22 23:50:09

楼上kmdz 真是高人，但有个问题，标注线是在一条直线上，但首尾标注点不对齐的话，好像就处理不了。

而且，可不可以改成只需要确定偏移的方向，就可以自动在离标注线500的位置进行标注呢？

(setq pt10  (lhj_dxf (entget (ssname dim-ss 0)) 10)
      pint  (inters pt
      (polar pt (+ ang lpi2) 1000)
      pt10
      (polar pt10 ang 1000)
      nil
      )
ang (angle pint pt)
)
(setq dim-dxf-10 (polar pt10 ang 500))
我改成这样怎么不行呢？

carrot1983 · 发表于 2009-3-23 12:37:46

斜的怎么样？？？

userzhluserzhl · 发表于 2009-3-23 12:46:00

斜的，如果是对齐的是可以的。

wuxuloveguo · 发表于 2009-3-23 15:01:31

确实存在这样的问题!

userzhluserzhl · 发表于 2009-3-25 09:51:23

急用,哪位高手帮忙完善一下吗?有大量的图需要这样处理的.
这么多人关注,怎么都没出招呢?

kmdz · 发表于 2009-3-25 10:33:48

while前加

(if (not *dim-dis-1410*) (setq *dim-dis-1410* 500.))
(if (not (setq *dim-dis-1410* (getdist
(strcat "\n指定基线间距<" (rtos *dim-dis-1410* 2 2) ">"))))
(setq *dim-dis-1410* 500.)
)

修改

dim-dxf-10 (polar dim-dxf-10 dim-ang-1410 (* dim-dis-1410 (1- dim-ss-n)) )

复制代码

为

dim-dxf-10 (polar dim-dxf-10 dim-ang-1410 *dim-dis-1410* )

复制代码

这样改了应该能满足你的要求，不行自己调试下。

userzhluserzhl · 发表于 2009-3-25 13:33:33

kmdz
我觉得思路可不可以这样：复制选集中的一个标注，提取选集的13，14成表，获取13和14距离最远的端点，得到新标注的两个端点，修改复制的那个标注定义数据。
而且可以看看这个文件,为何条件都满足了,就是标不了呢?

kmdz · 发表于 2009-3-25 17:41:54

再不行就没办法了。

userzhluserzhl · 发表于 2009-3-25 18:15:06

kmdz
还是不行呀.

yinjake007 · 发表于 2009-3-25 21:40:11

楼主真厉害，佩服

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

[求助] [求助]：如何做到框选这些标注后就生成下面红色的标注?

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

相关帖子