[讨论]：关于标注引线对齐的问题

qaz12345

13楼的能把方法形成文字好记些，我怕忘了，呵呵

yanwei_dy

我在这之前一直用第二种方法，不过看了这个帖子，我准备用13楼的方法了，不错！

围棋

如果CAD能自动对齐真是太好了。

ssmm

天正新版本真该开发一下这个功能

gogollg

COPY第一个标注，再把引脚拉伸到接下来的标注目标的垂点。

tj951

各位大虾,谁来编个裁减尺寸界限的lisp吧

colatree

我曾經在r12時用lisp寫了一個程式
正好用在這裡
acad2002想用的可試試看

;This MOVEDIM.LSP is MOVE dimension LINE

(defun movderr (s)                    ; If an error (such as CTRL-C) occurs
                                      ; while this command is active...
   (if (/= s "Function cancelled")
       (princ (strcat "\nError: " s))
   )
   (setq S nil)                       ; Free selection-set if any
   (setvar "CMDECHO" ocmd)            ; Restore saved mode
   (setq *error* movderr)              ; Restore old *error* handler
   (princ)
)

(defun dxf (code elist)
   (cdr (assoc code elist))
)

(defun getsegment (obj pt / cpt eParam stParam)
  (cond
    ((setq cpt (vlax-curve-getClosestPointTo obj pt T))
     (setq eParam (fix (vlax-curve-getEndParam obj)))
     (setq bul (vla-getBulge obj (fix (vlax-curve-getParamAtPoint obj cpt))))
     (if (= eParam (setq stParam (fix (vlax-curve-getParamAtPoint obj cpt))))
       (setq stParam (1- stParam))
       (setq eParam (1+ stParam))
     )
    (list (vlax-curve-getPointAtParam obj stParam)
           (vlax-curve-getPointAtParam obj eParam)
     )  
    )
  )
)
(defun c:movedim (/ olderr ocmd s a p1 p2 line pline n e e1 e2 e3 e12 e21
                    po1 po2 lx ly name point2 ent)

   (setq olderr  *error*
         *error* ovderr)
   (setq ocmd (getvar "CMDECHO"))
   (setvar "CMDECHO" 1)

   (setq p1 nil p2 nil)
   (setq lx nil ly nil)
   (setq s (ssget '((0 . "DIMENSION"))))
   (while (and (null lx) (null ly))
     (setq name (dxf 0 (setq line (entget (car (setq ent (nentsel "\nPlease select 1 line: ")))))));;需選擇0 or 90度的直線或pline
     (if (or (= name "LINE") (= name "VERTEX") (= NAME "LWPOLYLINE"))
       (progn
         (cond
           ((= name "LINE")
            (setq P1 (dxf 10 line))
            (setq p2 (dxf 11 line))
           )
           ((= name "VERTEX")
            (setq pline (entget (entnext (dxf -1 line))))
            (setq P1 (dxf 10 line))
            (setq P2 (dxf 10 pline))
           )
           ((= name "LWPOLYLINE")
            (SETQ POINT2 (getSegment (vlax-ename->vla-object (car ent)) (cadr ent)))
            (setq P1 (CAR POINT2))
            (setq P2 (CADR POINT2))
           )
         )
         (setq lx (equal (car p1) (car p2) 0.001))
         (setq ly (equal (cadr p1) (cadr p2) 0.001))
         (if (and (= lx nil) (= ly nil)) (prompt "\n**not ortho line**"))
       )
       (prompt "\nNo line or pline")
     )
   )
   (setq a 0)
   (setq n (sslength s))
   (repeat n
         (setq e (entget (ssname s a)))
         (setq e1 (dxf 14 e) e3 (dxf 10 e))
         (setq e2 (dxf 13 e))
         (setq e21
          (if (= (distance e1 e3) 0)
           (cond
             (ly (list (car e2) (+ 5 (cadr e3))))
             (lx (list (+ 5 (car e3)) (cadr e2)))
           )
           (cond
             (ly (list (car e2) (cadr e3)))
             (lx (list (car e3) (cadr e2)))
           )
          )
         )
         (setq e12
          (if (= (distance e1 e3) 0)
           (cond
             (ly (list (car e1) (+ 5 (cadr e3))))
             (lx (list (+ 5 (car e3)) (cadr e1)))
           )
           (cond
             (ly (list (car e1) (cadr e3)))
             (lx (list (car e3) (cadr e1)))
           )
          )
         )
         (setq po1 (inters p1 p2 e1 e12 nil))
         (setq po2 (inters p1 p2 e2 e21 nil))
         (if po1 (setq e (subst (cons '14 po1) (assoc '14 e) e)))
         (if po2 (setq e (subst (cons '13 po2) (assoc '13 e) e)))
     (setq a (1+ a))
     (if (and po1 po2) (entmod e))
     (setq e nil e1 nil e2 nil e21 nil e12 nil po1 nil po2 nil)
   )

   (setq s nil)
   (setvar "CMDECHO" ocmd)            ; Restore saved mode
   (setq *error* olderr)              ; Restore old *error* handler
   (princ)
)
(princ)