cad图块的自动标注定位

10410024

请问哪位大侠能否帮忙编一个块的自动定位程序啊。就是将一个图块的基点自动与相邻最近的两条垂直的直线（轴线）进行标注。论坛中有朋友指点：先算出图块的基点及 水平线和垂直线的交点，然后分成 两个数字表 X坐标，Y坐标，然后对两个表排序，然后取基点的X坐标值与相邻的两个数值相减，取绝对值，较小的就是要找的，Y坐标同样如此，X，Y合起来的那个点就是要找的点，再标注。能否可行，不知哪位高手可以帮忙编出来么！！

byghbcx

这个贴好久没有人回答，由于没测试图，发个给你看看，能否符合要求

2. (defun c:tt( / lay ss n xlist ylist en pt1 pt2 ang ss1 pt x y xlist1 ylist1 dimx dimy x1 x2 y1 y2)
   
3.   (command "_.undo" "be")
   
4.   (setvar "dimdsep" ".")
   
5.   (setvar "dimtxt" 5)
   
6.   (setvar "dimblk" "_archtick")
   
7.   (setq lay (cdr (assoc 8 (entget (car (entsel "\n请选择轴线所在图层:"))))))
   
8.   (setq ss (ssget "x" (list (cons 0 "line") (cons 8 lay))))
   
9.   (setq n 0 xlist nil ylist nil)
   
10.   (if ss
    
11.     (progn
    
12.       (repeat (sslength ss)
    
13.         (setq en (ssname ss n))
    
14.         (setq pt1 (cdr (assoc 10 (entget en))) pt2 (cdr (assoc 11 (entget en))))
    
15.         (setq ang (angle pt1 pt2))
    
16.         (cond ((or (= ang 0) (= ang pi)) (setq ylist (cons (cadr pt1) ylist)))
    
17.               ((or (= ang (* 0.5 pi)) (= ang (* 1.5 pi))) (setq xlist (cons (car pt1) xlist)))
    
18.               )
    
19.         (setq n (1+ n))
    
20.       )
    
21.       (princ "\n请选择要标注尺寸的图块:")
    
22.       (setq ss1 (ssget '((0 . "insert"))) n 0)
    
23.       (if ss1
    
24.         (progn
    
25.           (repeat (sslength ss1)
    
26.             (setq en (ssname ss1 n))
    
27.             (setq pt (cdr (assoc 10 (entget en))))
    
28.             (setq x (car pt) y (cadr pt))
    
29.             (setq xlist1 (vl-sort (cons x xlist) '<))
    
30.             (cond ((= x (car xlist1)) (setq dimx (cadr xlist1)))
    
31.                   ((= x (last xlist1)) (setq dimx (cadr (member x (reverse xlist1)))))
    
32.                   (t  (setq x1 (cadr (member x (reverse xlist1))) x2 (cadr (member x xlist1)))
    
33.                       (if (> (- x2 x) (- x x1)) (setq dimx x1) (setq dimx x2))
    
34.                   )
    
35.             )
    
36.             (command "_dimaligned" pt (list dimx (cadr pt)) (list dimy (- (cadr pt) 10)))
    
37.             (setq ylist1 (vl-sort (cons y ylist) '<))
    
38.             (cond ((= y (car ylist1)) (setq dimy (cadr ylist1)))
    
39.                   ((= y (last ylist1)) (setq dimy (cadr (member y (reverse ylist1)))))
    
40.                   (t  (setq y1 (cadr (member y (reverse ylist1))) y2 (cadr (member y ylist1)))
    
41.                       (if (> (- y2 y) (- y y1)) (setq dimy y1) (setq dimy y2))
    
42.                   )
    
43.             )
    
44.             (command "_dimaligned" pt (list (car pt) dimy) (list (- (car pt) 10) dimy))
    
45.             (setq n (1+ n))
    
46.           )
    
47.           )
    
48.         )
    
49.       )
    
50.     (princ "\n没有轴线")
    
51.     )
    
52.   (command "_.undo" "e")
    
53.   )

(defun c:tt( / lay ss n xlist ylist en pt1 pt2 ang ss1 pt x y xlist1 ylist1 dimx dimy x1 x2 y1 y2)<br />   (command "_.undo" "be")<br />   (setvar "dimdsep" ".")<br />   (setvar "dimtxt" 5)<br />   (setvar "dimblk" "_archtick")<br />   (setq lay (cdr (assoc 8 (entget (car (entsel "\n请选择轴线所在图层:"))))))<br />   (setq ss (ssget "x" (list (cons 0 "line") (cons 8 lay))))<br />   (setq n 0 xlist nil ylist nil)<br />   (if ss<br />     (progn<br />       (repeat (sslength ss)<br />         (setq en (ssname ss n))<br />         (setq pt1 (cdr (assoc 10 (entget en))) pt2 (cdr (assoc 11 (entget en))))<br />         (setq ang (angle pt1 pt2))<br />         (cond ((or (= ang 0) (= ang pi)) (setq ylist (cons (cadr pt1) ylist)))<br />               ((or (= ang (* 0.5 pi)) (= ang (* 1.5 pi))) (setq xlist (cons (car pt1) xlist)))<br />               )<br />         (setq n (1+ n))<br />       )<br />       (princ "\n请选择要标注尺寸的图块:")<br />       (setq ss1 (ssget '((0 . "insert"))) n 0)<br />       (if ss1<br />         (progn<br />           (repeat (sslength ss1)<br />             (setq en (ssname ss1 n))<br />             (setq pt (cdr (assoc 10 (entget en))))<br />             (setq x (car pt) y (cadr pt))<br />             (setq xlist1 (vl-sort (cons x xlist) '<))<br />             (cond ((= x (car xlist1)) (setq dimx (cadr xlist1)))<br />                   ((= x (last xlist1)) (setq dimx (cadr (member x (reverse xlist1)))))<br />                   (t  (setq x1 (cadr (member x (reverse xlist1))) x2 (cadr (member x xlist1)))<br />                       (if (> (- x2 x) (- x x1)) (setq dimx x1) (setq dimx x2))<br />                   )<br />             )<br />             (command "_dimaligned" pt (list dimx (cadr pt)) (list dimy (- (cadr pt) 10)))<br />             (setq ylist1 (vl-sort (cons y ylist) '<))<br />             (cond ((= y (car ylist1)) (setq dimy (cadr ylist1)))<br />                   ((= y (last ylist1)) (setq dimy (cadr (member y (reverse ylist1)))))<br />                   (t  (setq y1 (cadr (member y (reverse ylist1))) y2 (cadr (member y ylist1)))<br />                       (if (> (- y2 y) (- y y1)) (setq dimy y1) (setq dimy y2))<br />                   )<br />             )<br />             (command "_dimaligned" pt (list (car pt) dimy) (list (- (car pt) 10) dimy))<br />             (setq n (1+ n))<br />           )<br />           )<br />         )<br />       )<br />     (princ "\n没有轴线")<br />     )<br />   (command "_.undo" "e")<br />   )

10410024

兄弟们给力啊

byghbcx

可以上传测试图来看看

10410024

阿霸99

帮忙顶一下

xiaotao

好像没什么难度，10个币值得一试。

xiaotao

;自己优化一下，碰到多条线时暂不处理
(defun c:1 (/ mid dxf ss-y ss-x MINDIST ss ss1 name pt pt1 dis i test)
  (defun MID (PT1 PT2)
    (list
      (* 0.5 (+ (nth 0 PT1) (nth 0 PT2)))
      (* 0.5 (+ (nth 1 PT1) (nth 1 PT2)))
    )
  )
  (defun dxf (i name /)
    (cdr (assoc i (entget name)))
  )
  (defun ss-y (pt dis / pt1 pt2)
    (setq pt1 (list (- (car pt) dis) (- (cadr pt) 0.5)))
    (setq pt2 (list (+ (car pt) dis) (+ (cadr pt) 0.5)))
    (if        (setq ss1 (ssget "c" pt1 pt2 '((0 . "LINE"))))
      (if (and (= (sslength ss1) 1)
               (setq name (ssname ss1 0))
               (or
                 (equal        (angle (dxf 10 name) (dxf 11 name))
                        (* 0.5 pi)
                        0.0001
                 )
                 (equal        (angle (dxf 10 name) (dxf 11 name))
                        (* 1.5 pi)
                        0.0001
                 )
               )
          )
        T
        nil
      )
    )
  )
  (defun ss-x (pt dis / pt1 pt2)
    (setq pt1 (list (- (car pt) 0.5) (- (cadr pt) dis)))
    (setq pt2 (list (+ (car pt) 0.5) (+ (cadr pt) dis)))
    (if        (setq ss1 (ssget "c" pt1 pt2 '((0 . "LINE"))))
      (if (and (= (sslength ss1) 1)
               (setq name (ssname ss1 0))
               (or
                 (equal        (angle (dxf 10 name) (dxf 11 name))
                        0
                        0.0001
                 )
                 (equal        (angle (dxf 10 name) (dxf 11 name))
                        pi
                        0.0001
                 )
               )
          )
        T
        nil
      )
    )
  )
  (defun MINDIST (PT NAME /)
    (vlax-curve-getclosestpointto
      (vlax-ename->vla-object name)
      pt
      t
    )
  )
  (if (setq ss (ssget '((0 . "INSERT"))))
    (progn
      (setvar "osmode" 0)
      (setq i -1)
      (while (setq name (ssname ss (setq i (1+ i))))
        (setq pt   (trans (dxf 10 name) 0 1)
              test T
              dis  0
        )
        (while test
          (setq dis (+ dis 10))
          (if (> dis 2000)
            (setq test nil)
            (if        (ss-y pt dis)
              (progn
                (setq pt1 (trans (MINDIST (trans pt 1 0) name) 0 1))
                (if (> (distance pt pt1) 0)
                  (command "dimlinear" pt pt1 (mid pt pt1))
                )
                (setq test nil)
              )
            )
          )
        )
        (setq test T
              dis 0
        )
        (while test
          (setq dis (+ dis 10))
          (if (> dis 2000)
            (setq test nil)
            (if        (ss-x pt dis)
              (progn
                (setq pt1 (trans (MINDIST (trans pt 1 0) name) 0 1))
                (if (> (distance pt pt1) 0)
                  (command "dimlinear" pt pt1 (mid pt pt1))
                )
                (setq test nil)
              )
            )
          )
        )
      )
    )
  )
)

10410024

byghbcx 发表于 2012-1-10 09:25
这个贴好久没有人回答，由于没测试图，发个给你看看，能否符合要求

虽然目前为止未能解决问题，还是非常感谢兄弟的相助！！其实我想法很简单，第一步是选择相互垂直或平行的多条直线，第二步是选择希望定位标注的“块”，然后自动完成块的定位（块基点到最近的两条直线的垂直距离）。哪位大哥能否帮忙修改！！

byghbcx

10410024 发表于 2012-1-10 09:53
虽然目前为止未能解决问题，还是非常感谢兄弟的相助！！其实我想法很简单，第一步是选择相互垂直或平行的 ...

你的原图呢，我的测试图中可以运行