[LISP程序]：关于“尺寸断开命令: DIMB”LSP程序中，怎么让“输断开长度”选项有效？

tchthong

关于“尺寸断开命令: DIMB”LSP程序中，怎么让“输断开长度”选项有效？


(PRINC "\n尺寸断开命令: DIMB . 尺寸界限对齐:DB . 尺寸标注点对齐: DV . 尺寸宽度取齐: DIMW")
(DEFUN C:DIMB (/     ANG       DIMALANG  DIMENT    DIMPT10     DIMPT1013 DIMPT11
           DIMPT12     DIMPT13   DIMPT14   DIMPT15   DIMSEL     DIST       ENAME
           PT0     PT1       PTREF     SELPT     DIMANG1     DIMANG2   DIST2PT
           ID     NDIST       PT10         PT14      PTFROM
          )
  (DEFUN LHB-GET-DXF (CODE ENAME) (CDR (ASSOC CODE (ENTGET ENAME))))
  (DEFUN *$MYERROR$* (MSG)
    (SETVAR "BLIPMODE" OLDBLIP)
    (SETVAR "OSMODE" OLDOS)
    (SETVAR "CMDECHO" OLDCMD)
    (COMMAND ".UNDO" "")
    (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)
  (SETVAR "BLIPMODE" 1)
  (SETVAR "OSMODE" (+ 1 2 4 8 16 32 128 512 2048 4096))
  (SETQ
    DIMSEL (XENTSEL "\n拾取要拆分的尺寸(定位基点靠近点取位置)<退出>:"
            "U"
            '((0 . "DIMENSION"))
       )
  )
  (IF DIMSEL
    (PROGN
      (SETQ ENAME (CAR DIMSEL))
      (SETQ DIMENT (ENTGET ENAME))
      (REDRAW ENAME 3)
      (SETQ SELPT (CADR DIMSEL))
      (SETQ DIMPT10 (LHB-GET-DXF 10 ENAME))
      (SETQ DIMPT13 (LHB-GET-DXF 13 ENAME))
      (SETQ DIMPT14 (LHB-GET-DXF 14 ENAME))
      (IF (MEMBER '(100 . "AcDbRotatedDimension") (ENTGET ENAME))
    (PROGN                ;线性标注
      (SETQ DIMALANG (LHB-GET-DXF 50 ENAME))
      (COND
        ((OR (= DIMALANG 0.0) (= DIMALANG PI))
         (SETQ DIMPT1013 (LIST (CAR DIMPT13)
                   (CADR DIMPT10)
                   (CADDR DIMPT10)
                 )
         )
        )
        ((OR (= DIMALANG (* PI 0.5)) (= DIMALANG (* PI 1.5)))
         (SETQ DIMPT1013 (LIST (CAR DIMPT10)
                   (CADR DIMPT13)
                   (CADDR DIMPT13)
                 )
         )
        )
        (T
         (SETQ PT1 (POLAR DIMPT10 DIMALANG 10))
         (SETQ PT0 (POLAR DIMPT13 (+ DIMALANG (* PI 0.5)) 10))
         (SETQ DIMPT1013 (INTERS DIMPT13 PT0 DIMPT10 PT1 NIL))
        )
      )                ; END COND
      (IF (< (DISTANCE DIMPT1013 SELPT) (DISTANCE DIMPT10 SELPT))
        (SETQ PTFROM DIMPT1013)
        (SETQ PTFROM DIMPT10)
      )
      (INITGET 129)
      (SETQ    PTREF
         (GETPOINT
           PTFROM
           "\n点取尺寸断开点 /输断开长度 /数值N - N等分<退出>:"
         )
      )
      (SETQ ID T)
      (WHILE ID
        (IF    (OR (LISTP PTREF)
            (AND (ZEROP (REM (ATOF PTREF) 1))
             (NOT (ZEROP (ATOF PTREF)))
            )
        )
          (SETQ ID NIL)
          (PROGN
        (PRINC "\n***** 输入值无效,请重新输入! *****")
        (INITGET 129)
        (SETQ PTREF
               (GETPOINT
             PTFROM
             "\n点取尺寸断开点 /输断开长度 /数值N - N等分<退出>:"
               )
        )
          )
        )
      )                ; END OF WHILE ID
      (IF (LISTP PTREF)
        (PROGN
          (SETQ DIMPT15 (POLAR PTREF (+ DIMALANG (* PI 0.5)) 10))
          (SETQ DIMPT11 (INTERS DIMPT15
                    PTREF
                    DIMPT10
                    (POLAR DIMPT10 DIMALANG 10)
                    NIL
                )
          )
          (SETQ ANG (ANGLE DIMPT10 DIMPT14))
          (IF
        (< (DISTANCE DIMPT1013 DIMPT11)
           (DISTANCE DIMPT10 DIMPT11)
        )
         (SETQ DIST (DISTANCE DIMPT13 DIMPT1013))
         (SETQ DIST (DISTANCE DIMPT14 DIMPT10))
          )
          (SETQ DIMPT12 (POLAR DIMPT11 ANG DIST))
          (IF (AND (< (DISTANCE DIMPT11 DIMPT10)
              (DISTANCE DIMPT10 DIMPT1013)
               )
               (< (DISTANCE DIMPT11 DIMPT1013)
              (DISTANCE DIMPT10 DIMPT1013)
               )
          )            ;断开点在尺寸线上
        (PROGN
          (NEWDIM DIMPT11
              DIMPT12
              (CDR (ASSOC 13 DIMENT))
              DIMENT
          )
          (SETQ    DIMENT (SUBST (CONS 13 DIMPT12)
                      (ASSOC 13 DIMENT)
                      DIMENT
                   )
          )
          (ENTMOD DIMENT)
        )
        (PROGN
          (IF (< (DISTANCE DIMPT1013 DIMPT11)
             (DISTANCE DIMPT10 DIMPT11)
              )
            (NEWDIM DIMPT11
                DIMPT12
                (CDR (ASSOC 13 DIMENT))
                DIMENT
            )
            (NEWDIM DIMPT11
                DIMPT12
                (CDR (ASSOC 14 DIMENT))
                DIMENT
            )
          )
          (REDRAW ENAME 4)
        )
          )
        )                ;END OF PROGN
        (PROGN
          (SETQ DIST2PT (DISTANCE DIMPT10 DIMPT1013))
          (SETQ NDIST (/ DIST2PT (ATOI PTREF)))
          (SETQ DIMANG1 (ANGLE DIMPT1013 DIMPT10))
          (SETQ DIMANG2 (ANGLE DIMPT10 DIMPT14))
          (SETQ DIST (DISTANCE DIMPT10 DIMPT14))
          (REPEAT (- (ATOI PTREF) 1)
        (SETQ PT10 (POLAR DIMPT1013 DIMANG1 NDIST))
        (SETQ PT14 (POLAR PT10 DIMANG2 DIST))
        (NEWDIM PT10 PT14 DIMPT13 DIMENT)
        (SETQ DIMPT1013 PT10)
        (SETQ DIMPT13 PT14)
          )
          (SETQ DIMENT (SUBST (CONS 13 PT14)
                  (ASSOC 13 DIMENT)
                  DIMENT
               )
          )
          (ENTMOD DIMENT)
        )
      )
    )

    (PROGN                ;对齐标注
      (SETQ DIMALANG (ANGLE DIMPT13 DIMPT14))
      (SETQ PT1 (POLAR DIMPT10 DIMALANG 10))
      (SETQ PT0 (POLAR DIMPT13 (+ DIMALANG (* PI 0.5)) 10))
      (SETQ DIMPT1013 (INTERS DIMPT13 PT0 DIMPT10 PT1 NIL))
      (IF (< (DISTANCE DIMPT1013 SELPT) (DISTANCE DIMPT10 SELPT))
        (SETQ PTFROM DIMPT1013)
        (SETQ PTFROM DIMPT10)
      )
      (INITGET 129)
      (SETQ    PTREF
         (GETPOINT
           PTFROM
           "\n点取尺寸断开点 /输断开长度 /数值N - N等分<退出>:"
         )
      )
      (SETQ ID T)
      (WHILE ID
        (IF    (OR (LISTP PTREF)
            (AND (ZEROP (REM (ATOF PTREF) 1))
             (NOT (ZEROP (ATOF PTREF)))
            )
        )
          (SETQ ID NIL)
          (PROGN
        (PRINC "\n***** 输入值无效,请重新输入! *****")
        (INITGET 129)
        (SETQ PTREF
               (GETPOINT
             PTFROM
             "\n点取尺寸断开点 /输断开长度 /数值N - N等分<退出>:"
               )
        )
          )
        )
      )                ; END OF WHILE ID
      (IF (LISTP PTREF)
        (PROGN
          (SETQ DIMPT15 (POLAR PTREF (+ DIMALANG (* PI 0.5)) 10))
          (SETQ DIMPT11 (INTERS DIMPT15
                    PTREF
                    DIMPT10
                    (POLAR DIMPT10 DIMALANG 10)
                    NIL
                )
          )
          (SETQ ANG (ANGLE DIMPT10 DIMPT14))
          (IF
        (< (DISTANCE DIMPT1013 DIMPT11)
           (DISTANCE DIMPT10 DIMPT11)
        )
         (SETQ DIST (DISTANCE DIMPT13 DIMPT1013))
         (SETQ DIST (DISTANCE DIMPT14 DIMPT10))
          )
          (SETQ DIMPT12 (POLAR DIMPT11 ANG DIST))
          (IF (AND (< (DISTANCE DIMPT11 DIMPT10)
              (DISTANCE DIMPT10 DIMPT1013)
               )
               (< (DISTANCE DIMPT11 DIMPT1013)
              (DISTANCE DIMPT10 DIMPT1013)
               )
          )            ;断开点在尺寸线上
        (PROGN
          (NEWDIMALI DIMPT11
                 DIMPT12
                 (CDR (ASSOC 13 DIMENT))
                 DIMENT
          )
          (SETQ    DIMENT (SUBST (CONS 13 DIMPT12)
                      (ASSOC 13 DIMENT)
                      DIMENT
                   )
          )
          (ENTMOD DIMENT)
        )
        (PROGN
          (IF (< (DISTANCE DIMPT1013 DIMPT11)
             (DISTANCE DIMPT10 DIMPT11)
              )
            (NEWDIMALI DIMPT11
                   DIMPT12
                   (CDR (ASSOC 13 DIMENT))
                   DIMENT
            )
            (NEWDIMALI DIMPT11
                   DIMPT12
                   (CDR (ASSOC 14 DIMENT))
                   DIMENT
            )
          )
          (REDRAW ENAME 4)
        )
          )
        )                ;END OF PROGN
        (PROGN
          (SETQ DIST2PT (DISTANCE DIMPT10 DIMPT1013))
          (SETQ NDIST (/ DIST2PT (ATOI PTREF)))
          (SETQ DIMANG1 (ANGLE DIMPT1013 DIMPT10))
          (SETQ DIMANG2 (ANGLE DIMPT10 DIMPT14))
          (SETQ DIST (DISTANCE DIMPT10 DIMPT14))
          (REPEAT (- (ATOI PTREF) 1)
        (SETQ PT10 (POLAR DIMPT1013 DIMANG1 NDIST))
        (SETQ PT14 (POLAR PT10 DIMANG2 DIST))
        (NEWDIMALI PT10 PT14 DIMPT13 DIMENT)
        (SETQ DIMPT1013 PT10)
        (SETQ DIMPT13 PT14)
          )
          (SETQ DIMENT (SUBST (CONS 13 PT14)
                  (ASSOC 13 DIMENT)
                  DIMENT
               )
          )
          (ENTMOD DIMENT)
        )
      )
    )
      )
    )
  )
  (SETVAR "BLIPMODE" OLDBLIP)
  (SETVAR "OSMODE" OLDOS)
  (COMMAND ".UNDO" "E")
  (SETVAR "CMDECHO" OLDCMD)
  (SETQ *ERROR* &OLDERR&)
  (PRINC)
)

(DEFUN NEWDIM (DIMPT11 DIMPT14 DIMPT13 DIMENT)
  (SETQ    NEWDIM1
     (LIST
       '(0 . "DIMENSION")
       '(100 . "AcDbEntity")
       (CONS 67 (CDR (ASSOC 67 DIMENT)))
       '(100 . "AcDbDimension")
       (CONS 8 (CDR (ASSOC 8 DIMENT)))
       (CONS 10 DIMPT11)
       (CONS 12 (CDR (ASSOC 12 DIMENT)))
       (CONS 70 (CDR (ASSOC 70 DIMENT)))
       '(1 . "")
       (CONS 71 (CDR (ASSOC 71 DIMENT)))
       (CONS 72 (CDR (ASSOC 72 DIMENT)))
       (CONS 41 (CDR (ASSOC 41 DIMENT)))
       (CONS 52 (CDR (ASSOC 52 DIMENT)))
       (CONS 53 (CDR (ASSOC 53 DIMENT)))
       (CONS 54 (CDR (ASSOC 54 DIMENT)))
       (CONS 51 (CDR (ASSOC 51 DIMENT)))
       (CONS 3 (CDR (ASSOC 3 DIMENT)))
       '(100 . "AcDbAlignedDimension")
       (CONS 13 DIMPT13)
       (CONS 14 DIMPT14)
       (CONS 15 (CDR (ASSOC 15 DIMENT)))
       (CONS 16 (CDR (ASSOC 16 DIMENT)))
       (CONS 40 (CDR (ASSOC 40 DIMENT)))
       (CONS 50 (CDR (ASSOC 50 DIMENT)))
       '(100 . "AcDbRotatedDimension")
     )
  )
  (ENTMAKE NEWDIM1)
)

(DEFUN NEWDIMALI (DIMPT11 DIMPT14 DIMPT13 DIMENT)
  (SETQ    NEWDIM1
     (LIST
       '(0 . "DIMENSION")
       '(100 . "AcDbEntity")
       (CONS 67 (CDR (ASSOC 67 DIMENT)))
       '(100 . "AcDbDimension")
       (CONS 8 (CDR (ASSOC 8 DIMENT)))
       (CONS 10 DIMPT11)
       (CONS 12 (CDR (ASSOC 12 DIMENT)))
       (CONS 70 (CDR (ASSOC 70 DIMENT)))
       '(1 . "")
       (CONS 71 (CDR (ASSOC 71 DIMENT)))
       (CONS 72 (CDR (ASSOC 72 DIMENT)))
       (CONS 41 (CDR (ASSOC 41 DIMENT)))
       (CONS 52 (CDR (ASSOC 52 DIMENT)))
       (CONS 53 (CDR (ASSOC 53 DIMENT)))
       (CONS 54 (CDR (ASSOC 54 DIMENT)))
       (CONS 51 (CDR (ASSOC 51 DIMENT)))
       (CONS 3 (CDR (ASSOC 3 DIMENT)))
       '(100 . "AcDbAlignedDimension")
       (CONS 13 DIMPT13)
       (CONS 14 DIMPT14)
       (CONS 15 (CDR (ASSOC 15 DIMENT)))
       (CONS 16 (CDR (ASSOC 16 DIMENT)))
       (CONS 40 (CDR (ASSOC 40 DIMENT)))
       (CONS 50 (CDR (ASSOC 50 DIMENT)))
     )
  )
  (ENTMAKE NEWDIM1)
)

(DEFUN XENTSEL (MSG KEYWORD FILTER_LIST / $S0 $S01)
  (INITGET KEYWORD)
  (SETQ $S0 (ENTSEL MSG))
  (COND
    ((AND (= $S0 NIL) (= (GETVAR "ERRNO") 52)) NIL) ;回车结束，返回NIL
    ((= $S0 NIL) (XENTSEL MSG KEYWORD FILTER_LIST)) ;空选重复
    ((= (TYPE $S0) 'STR) $S0)        ;返回关键字
    ((= (TYPE $S0) 'LIST)        ;返回实体与点表，与ENTSEL相同
     (IF FILTER_LIST            ;存在特征关联表
       (IF (AND    (SETQ $S01 (SSGET (CADR $S0) FILTER_LIST))
        (SSMEMB (CAR $S0) $S01)
       )
     $S0                ;真，返回实体与点表
     (XENTSEL MSG KEYWORD FILTER_LIST) ;假，循环拾取
       )
       $S0
     )
    )
    (T (XENTSEL MSG KEYWORD FILTER_LIST)) ;其它拾取及输入情况，循环拾取
  )
)