大师们，看看这个轴线标注的程序如何更简单实用，如何优化？

lliushaojiang

(PROMPT "\n             正 在 装 入 土 建 轴 线 标 注 程 序 ! ")
(PROMPT "\n             ------------=================--------------")
(PROMPT "\n                           请   稍   候 ...")


;-----------------------------------------------------------------------
;                   尺寸及轴线号标注
;-----------------------------------------------------------------------

(DEFUN DIM_CC (DIM_SUBB P_BAS / XXB E1 SS P1 P5 P6 ANG_X L_S L_T
       BZ_CMD ANG_D L_BDIM L_DIM L_DIM1 L_DIM2 SL ZX_H ZXH ZXH1
      )
  (SETQ ANG_D (GETANGLE P_BAS "\n     请输入尺寸引出线方向: "))
;;;  (command "style" "standard" "gbenor,gbcbig" "" 1 "" "" "");设置standard字体
  (IF (OR (= ANG_D ANG9) (= ANG_D ANG27)) (PROGN
      (SETQ BZ_CMD "HOR" )
      (SETQ ANG_X (ANGLE (NTH 0 DIM_SUBB) (LIST (CAR (NTH 1 DIM_SUBB)) (CADR (NTH 0 DIM_SUBB)))))
    ) (PROGN
      (SETQ BZ_CMD "VER")
      (SETQ ANG_X (ANGLE (NTH 0 DIM_SUBB) (LIST (CAR (NTH 0 DIM_SUBB)) (CADR (NTH 1 DIM_SUBB)))))
  ))

  (SETQ L_BDIM (GETINT "\n     引出线始点与标注线距离(mm): <0>"))
  (IF (= L_BDIM NIL) (SETQ L_BDIM (* k 10)))
  (SETQ L_DIM  (* K 30)
        L_DIM1 (- L_DIM (* 18 K))
        L_DIM2 (- L_DIM (* 10 K)))

  (SETQ SL (LENGTH DIM_SUBB) B_LS '() B_LS1 '())         ;需标注的柱子数


  ;--------------- 分析座标表,完成尺寸标注信息 (xxb 柱距,跨距)--------------
  (SETQ XXB '() I 0)
  (REPEAT (1- SL)
     (IF (OR (= ANG_D 0) (= ANG_D PI))
         (SETQ XXB (APPEND XXB (LIST (ABS (- (CADR (NTH (1+ I) DIM_SUBB)) (CADR (NTH I DIM_SUBB)))))))
         (SETQ XXB (APPEND XXB (LIST (ABS (- (CAR (NTH (1+ I) DIM_SUBB)) (CAR (NTH I DIM_SUBB)))))))
     )
     (SETQ I (1+ I))
  )

  ;--------------- 画尺寸线及轴号圆 --------------------------
  (SETQ P5 (POLAR (NTH 0 DIM_SUBB) ANG_D L_BDIM)
        P6 (POLAR P5 ANG_D L_DIM))
  (COMMAND "CIRCLE" "2P" P6 (POLAR P6 ANG_D (* 8 K)))
  (SETQ E1 (ENTLAST))
;;;  (COMMAND "LINE" P6 P5 "")
  (SETQ SS (SSADD))
  (WHILE E1
     (SETQ SS (SSADD E1 SS))
     (SETQ E1 (ENTNEXT E1))
  )
  (SETQ I 0 P1 P5)
  (REPEAT (1- SL)
    (COMMAND "COPY" SS "" P5 (SETQ P1 (POLAR P1 ANG_X (NTH I XXB))))
    (SETQ I (1+ I))
  )
  ;------------ 标 注 尺 寸 ------------------
  (COMMAND "LAYER" "s" "DIM" "")
  (SETQ P1 (POLAR P5 ANG_D L_DIM1)
        L_S (CAR XXB)
        P6 (POLAR P1 ANG_X L_S))
  (COMMAND "DIMLINEAR" P1 P6 BZ_CMD (POLAR P1 ANG_D (* 2 K)))
  (SETQ I 1 L_T L_S)
  (WHILE (< I (1- SL))
    (SETQ L_S (NTH I XXB))
    (SETQ L_T (+ L_T L_S 0.0))
    (SETQ P6 (POLAR P6 ANG_X L_S))
    (if (= i 1) (COMMAND "DIMCONTINUE" P6) (COMMAND P6))
    (SETQ I (1+ I))
  )
;;;  (COMMAND "" "")
  (SETQ P1 (POLAR P5 ANG_D L_DIM2))
  ;(COMMAND "DIMLINEAR" P1 (POLAR P6 ANG_D (* 8 K)) BZ_CMD (POLAR P1 ANG_D (* 2 K)))
  (COMMAND "LAYER" "s" "0" "")
  ;------------------------------------------------------------
  ;          写   轴   线   号
  ;------------------------------------------------------------
  (SETQ P1 (POLAR P5 ANG_D (+ L_DIM (* K 4))))
  (PRINT)
  ;(command "style" "STANDARD" "Standard" "" 0.7 "" "" "" "")
  (SETQ ZXH (GETSTRING "\n    请输入第 1 个轴线符号:"))
  (COMMAND "TEXT" "s" "STANDARD" "M" P1 (* 4 K) 0 ZXH)
  (SETQ ZX_H (READ ZXH))
  (COND ((= (TYPE ZX_H) 'INT) (SETQ ZXH1 (ITOA (1+ ZX_H))))
        ((= (TYPE ZX_H) 'REAL) (SETQ ZXH1 (ITOA (1+ (FIX ZX_H)))))
        (T   (SETQ ZXH2 (1+ (ASCII ZXH))
                   ZXH1 (CHR ZXH2))
        )
  )
  (SETQ I 0)
  (REPEAT (1- SL)
     (SETQ P1 (POLAR P1 ANG_X (NTH I XXB)) ZXH NIL)
     (INITGET 1)
;     (PRINC "\n------------------------------------------------------------------------\n")
     (PRINT)
     (SETQ ZXH (GETSTRING (STRCAT "\n    请输入第 " (ITOA (1+ I)) " 个轴线符号: < " ZXH1 " >")))
     (IF (= ZXH "") (SETQ ZXH ZXH1))
     (SETQ ZX_H (READ ZXH))
     (COND ((= (TYPE ZX_H) 'INT) (SETQ ZXH1 (ITOA (1+ ZX_H))))
           ((= (TYPE ZX_H) 'REAL) (SETQ ZXH1 (ITOA (1+ (FIX ZX_H)))))
           (T   (SETQ ZXH2 (1+ (ASCII ZXH))
                      ZXH1 (CHR ZXH2))
           )
     )
     (COMMAND "TEXT" "s" "STANDARD" "M" P1 (* 4 K) 0 ZXH)
     (SETQ I (1+ I))
   )
)

(DEFUN P_INPUT ( / P_TEMP P_BS0)
    (SETQ P_TEMP (GETPOINT "\n    请输入参考点: "))
    (SETQ P_BS0 (GETPOINT "\n    与参考点的相对距离±(X,Y): "))
    (setq P_TEMP (MAPCAR '+ P_TEMP P_BS0))
    P_TEMP
)

;---------------------- 主程序 ----------------------
(DEFUN C:ZX ( / I BZ_S3 B_DIM P_BAS BZ_XZ )
   (SETVAR "CMDECHO" 0)
   ;(SETVAR "DIMSE1" 1)
   ;(SETVAR "DIMSE2" 1)
   (SETQ BZ_XZ "Yes")
   (SETQ ANG9 (/ PI 2) ANG27 (* ANG9 3))
   (PRINT)
   (PROMPT "\n------------------------------------------------------------------------")
   (WHILE (= BZ_XZ "Yes")
       (SETQ B_DIM '() P_BAS NIL BZ_S3 "DD" I 1)
       (WHILE (/= BZ_S3 NIL)
           (SETVAR "OSMODE" 4031)
           (INITGET "Refe Other")
           (IF (= I 1) (progn (initget 1)
              (SETQ BZ_S3 (GETPOINT "\n    请输入轴线引线点:  R--参考点 / O--其他点 / <柱中心点(INT)>: ")))
              (SETQ BZ_S3 (GETPOINT BZ_S3 "\n          下一引线点:  R--参考点 / O--其他点 / <柱中心点(INT)>: "))
           )
           (SETVAR "OSMODE" 4031)
           (COND ((= BZ_S3 "Refe")   (SETQ BZ_S3 (P_INPUT)))
                 ((= BZ_S3 "Other")    (SETQ BZ_S3 (GETPOINT "\n    请输入轴线引线点: ")))
                 ((= (TYPE BZ_S3) 'LIST) (SETQ B_DIM (APPEND B_DIM (LIST BZ_S3))))
           )
           (IF (= I 1) (SETQ P_BAS BZ_S3))
           (SETQ I (1+ I))
           (PRINT)
       )

       (DIM_CC B_DIM P_BAS)
       (PRINT)
       (PROMPT "\n\n************************************************************************")
       (initget (+ 2 4) "Yes No")
       (SETQ BZ_XZ (GETKWORD "\n    还需要标轴线号吗? (Yes/No): < N > "))
       (IF (= BZ_XZ nil) (SETQ BZ_XZ "N"))
   )
   (print)
   (prompt "\n            轴线标注完成 !")
   (command "layer" "s" 0 "" )
   (command "linetype" "s" "bylayer" "")
   (command "color" "bylayer")
   (command "textstyle" "standard")
   (SETVAR "cmdecho" 1)
   ;(SETVAR "DIMSE1" 0)
   ;(SETVAR "DIMSE2" 0)
(prin1)
)
(PRINC)

newer

怎么的你也得做个演示啊。

newer

不能点一下轴线，就把和它相交的所有轴号尺寸都标注出来吗?

lliushaojiang

最好是能修改成点了线一端后，会自动按序生成！或有一个动态效果，可按单一轴线生成，然后再点下一轴线连带尺寸标注一块生成，就类似于连续标注的意思。

xvjiex

感谢楼主分享

WDQ526

我怎么标出来是空气，什么也没有