[编程申请]：各位长老斑竹们能不能帮着编一个这样的标注修改程序啊？

ahopera

我想把所有的尺寸标注边界线都改成一样长的，可以构造一条线和尺寸线一样长且平行于尺寸线的线，把两个尺寸标注点原边界对齐到这根线上，这样就可以把尺寸标注的边界线都改成一样长了，谁能帮忙编一个这样的程序啊

Dallas_whu

不知道你在说什么？可能是要这个吧！
[PHP]
;;;尺寸标注点对齐
(DEFUN C:DV (/        DIMPT10  OLDBLIPM  OLDOSMODE PT             PTX       PTY         DIMSS
             INDEX     SSNUM         ENAME           ENTNAME   DIMCODE   DIMPT13         DIMPT14
             DIMALANG  ALIDIST         PT0           ANG             ANGPTIN   PT3         PT1
             DIMPT1013 INTERPT
            )
  (DEFUN LHB-GET-DXF (CODE ENAME) (CDR (ASSOC CODE (ENTGET ENAME))))
  (DEFUN *$MYERROR$* (MSG)
    (SETVAR "BLIPMODE" OLDBLIP)
    (SETVAR "OSMODE" OLDOS)
    (COMMAND ".UNDO" "")
    (COMMAND ".UCS" "P")
    (SETVAR "CMDECHO" OLDCMD)
    (SETQ *ERROR* &OLDERR&)
    (PRINC)
    )
  (SETQ &OLDERR& *ERROR*)
  (SETQ *ERROR* *$MYERROR$*)
  (SETQ OLDCMD (GETVAR "CMDECHO"))
  (SETQ OLDOS (GETVAR "OSMODE"))
  (SETQ OLDBLIP (GETVAR "BLIPMODE"))
  (SETVAR "CMDECHO" 0)
  (COMMAND ".UNDO" "BE")
  (COMMAND "UCS" "W")
  (SETVAR "BLIPMODE" 1)
  (SETVAR "OSMODE" (+ 1 2 4 8 16 32 128 512 2048 4096))
  (SETQ PT (GETPOINT "\n尺寸标注点对齐，请选择尺寸标注的对齐点:"))
  (SETQ PTX (CAR PT))
  (SETQ PTY (CADR PT))
  (PRINC "\n请选择尺寸标注：")
  (SETQ DIMSS (SSGET '((0 . "DIMENSION"))))
  (SETQ INDEX 0)
  (SETQ SSNUM (SSLENGTH DIMSS))
  (WHILE (< INDEX SSNUM)
    (SETQ ENAME (SSNAME DIMSS INDEX))
    (SETQ ENTNAME (ENTGET ENAME))
    (SETQ DIMCODE (LHB-GET-DXF 70 ENAME))
    (SETQ DIMPT10 (LHB-GET-DXF 10 ENAME))
    (SETQ DIMPT13 (LHB-GET-DXF 13 ENAME))
    (SETQ DIMPT14 (LHB-GET-DXF 14 ENAME))
    (IF        (OR (= DIMCODE 32) (= DIMCODE 160))
      (PROGN
        (SETQ DIMALANG (LHB-GET-DXF 50 ENAME))
        (COND
          ((OR (= DIMALANG 0.0) (= DIMALANG PI))
           (PROGN
             (SETQ DIMPT13 (LIST (CAR DIMPT13) PTY (CADDR DIMPT13)))
             (SETQ DIMPT14 (LIST (CAR DIMPT14) PTY (CADDR DIMPT14)))
           )
          )                                ;OR
          ((OR (= DIMALANG (* PI 0.5)) (= DIMALANG (* PI 1.5)))
           (PROGN
             (SETQ DIMPT13 (LIST PTX (CADR DIMPT13) (CADDR DIMPT13)))
             (SETQ DIMPT14 (LIST PTX (CADR DIMPT14) (CADDR DIMPT14)))
           )
          )                                ;OR
          (T
           (PROGN
             (SETQ PT0 (POLAR PT (+ DIMALANG (* PI 0.5)) 10))
             (SETQ PT1 (POLAR DIMPT10 DIMALANG 10))
             (SETQ INTERPT (INTERS PT PT0 PT1 DIMPT10 NIL))
             (SETQ ALIDIST (DISTANCE PT INTERPT))
             (SETQ ANG (ANGLE INTERPT PT))
             (SETQ DIMPT14 (POLAR DIMPT10 ANG ALIDIST))
             (SETQ PT3 (POLAR DIMPT13 (+ DIMALANG (* PI 0.5)) 10))
             (SETQ DIMPT1013 (INTERS DIMPT13 PT3 DIMPT10 PT1 NIL))
                                        ;得到13对应的尺寸界限
             (SETQ DIMPT13 (POLAR DIMPT1013 ANG ALIDIST))
           )
          )                                ;T
        )                                ;END COND
        (SETQ
          ENTNAME (SUBST (CONS 13 DIMPT13) (ASSOC 13 ENTNAME) ENTNAME)
        )
        (SETQ
          ENTNAME (SUBST (CONS 14 DIMPT14) (ASSOC 14 ENTNAME) ENTNAME)
        )
        (ENTMOD ENTNAME)
      )                                        ;PROGN
    )                                        ;IF DIMCODE 32
    (IF        (OR (= DIMCODE 33) (= DIMCODE 161))
      (PROGN
        (SETQ ANG (ANGLE DIMPT13 DIMPT14))
        (SETQ PT0 (POLAR PT (+ ANG (/ PI 2)) 10))
        (SETQ INTERPT (INTERS PT PT0 DIMPT13 DIMPT14 NIL))
        (SETQ ALIDIST (DISTANCE PT INTERPT))
        (SETQ ANGPTIN (ANGLE INTERPT PT))
        (SETQ DIMPT13 (POLAR DIMPT13 ANGPTIN ALIDIST))
        (SETQ DIMPT14 (POLAR DIMPT14 ANGPTIN ALIDIST))
        (SETQ
          ENTNAME (SUBST (CONS 13 DIMPT13) (ASSOC 13 ENTNAME) ENTNAME)
        )
        (SETQ
          ENTNAME (SUBST (CONS 14 DIMPT14) (ASSOC 14 ENTNAME) ENTNAME)
        )
        (ENTMOD ENTNAME)
      )
    )
    (SETQ INDEX (1+ INDEX))
  )
  (SETVAR "BLIPMODE" OLDBLIP)
  (SETVAR "OSMODE" OLDOS)
  (COMMAND ".UNDO" "E")
  (COMMAND ".UCS" "P")
  (SETVAR "CMDECHO" OLDCMD)
  (SETQ *ERROR* &OLDERR&)
  (PRINC)
)
[/php]

carrot1983

http://acad.net.cn/viewthread.ph ... &extra=page%3D1
来看看...

ahopera

太好了,这正是我要的,但是高手能不能改一下,改成可以设置对齐线长度的,比如是标注字高的几倍,这个倍数可以存在注册表里或文件里,在使用命令后只要选标注就可以了而不必再点一下点,而且可以确保所修改的标注范围线都是一样长的,以便保持图件的美观呢?比如这个程序同时修改两个标注X长度和Y长度的标注时,就会产生一个标注线短了,一个标注线长了,即标注方向不一样的话,修改的标注就会产生错误的对齐