标件号程序

正航

(defun c:DYBJH (/ dcl_id p1 p2 p3 p4 d e1 txt no osm tc zi nt nox no)
  (setq tc (getvar "clayer"))
  (setq zi (getvar "textstyle"))
  (setq osm (getvar "osmode"))
  (command "-style"          "DYDim"         "gbeitc.shx,gbcbig.shx"
           "5"                  "0.9"                 "0"                "N"
           "N"
          )
  (setvar "orthomode" 0)
  (setvar "CMDECHO" 0)
  (setvar "regenmode" 0)
;; (SETVAR "CLAYER" "14")
  (princ "\n            =======  件号标注程序  =======      ")
  (princ
    "\n   当您输入件号A时,将进行向上重叠标注;当您输入件号B时,进行水平连续标注，X退出。"
  )
  (setq d "TK")
  (setq e1 1)
  (setvar "osmode" 0)
  (while d
    (setq no (dos_getstring "件号标注" "请输入件号：" (itoa e1)));;DOSLIB的GUI仅为界面美观
    (if        (= no nil)
      (setq d nil)
      (progn
        (setq nt no)
        (if (or (= no "X") (= no "x"))
          ;;退出循环
          (setq d nil)
          (progn
            (if        (= no "")
              (setq no (itoa e1))
              ;;预赋值
            )
            (if        (or (= no "a") (= no "A"))
              (zcadjh2)
              ;;直
            )
            (if        (or (= no "b") (= no "B"))
              (zcadjh3)
            )
            (if        (and (/= nt "a") (/= nt "b") (/= nt "A") (/= nt "B"))
              (progn
                (setq nox (atoi no))
                (if (= nox 0)
                  (progn
                    (alert
                      "\n  对不起,您输入了非法的件号!程序将中止执行.\n\n           请核对后重新开始."
                    )
                    (setq d nil)
                  )
                )
                (if (/= nox 0)
                  (zcadjh1)
                )
              )
            )
          )
        )
      )
    )
  )
  (setvar "osmode" osm)
;; (setvar "clayer" tc)
  (setvar "textstyle" zi)
  (princ)
)

(defun zcadjh1 ()
  ;;普通形式
  (setq p1 (getpoint "\n目标件位置:"))
  (if (= p1 nil)
    (setq d nil)
  )
  (if (/= p1 nil)
    (progn
      (setq p2 (getpoint p1 "\n标号位置:"))
      (if (>= (car p2) (car p1))
        (setq p3 (list (+ (car p2) 12) (cadr p2)))
      )
      (if (< (car p2) (car p1))
        (setq p3 (list (- (car p2) 12) (cadr p2)))
      )
      (setq p4 (list (/ (+ (car p3) (car p2)) 2) (+ (cadr p3) 1)))
      (command ".LAYER" "S" "14" (terpri))
      (setq txt no)
      (COMMAND ".TEXT" "_c" P4 "0" txt)
      (command ".pline" p2 p3 "")
      (command ".undo" "be")
      (command ".pline"        p1 "H" "0.1" ""        "A" "r"        "0.081"        "A" "359.999" "" "L" "H"
               "0" "0" p2 "")
      (command ".undo" "e")
      (setq txt (itoa nox))
      (setq e1 nox)
      (setq nox (+ nox 1))
      (setq e1 (+ 1 e1))
    )
  )
)

(defun zcadjh2 () ;垂直标
  (command ".layer" "s" "14" "")
  (if (>= (car p1) (car p2))
    (zcadjh21)
    (zcadjh22)
  )
)

(defun zcadjh21        ()
  (setq pg p2)
  (setq p2 (list (car p2) (+ (cadr p2) 8)))
  (setq p3 (list (car p3) (+ (cadr p3) 8)))
  (setq p4 (list (/ (+ (car p2) (car p3)) 2) (+ (cadr p3) 1.5)))
  (setq txt (rtos e1))
  (command ".text" "_C" p4 "0" txt)
  (command ".pline" pg p2 p3 "")
  (setq txt (itoa nox))
  (setq e1 nox)
  (setq nox (+ nox 1))
  (setq e1 (+ 1 e1))
  (setq no (itoa nox))
)

(defun zcadjh22        ()
  (command ".undo" "2")
  (command ".layer" "s" "14" "")
  (setq pg p2)
  (setq p2 (list (car p2) (- (cadr p2) 8)))
  (setq p3 (list (car p3) (- (cadr p3) 8)))
  (setq p4 (list (/ (+ (car p2) (car p3)) 2) (+ (cadr p3) 1.5)))
  (setq        k1 (list (/ (+ (car p1) (car pg)) 2)
                 (/ (+ (cadr p1) (cadr pg)) 2)
           )
  )
  (setq txt (rtos e1))
  (command ".text" "_C" p4 "0" txt)
  (command ".pline" pg p2 p3 "")
  (setq txt (itoa nox))
  (setq e1 nox)
  (setq nox (+ nox 1))
  (setq e1 (+ 1 e1))
  (setq no (itoa nox))
  (command ".undo" "be")
  (command ".pline" p1 "H" "0.1" "" "A"        "r" "0.081" "A"        "359.999" "" "L" "H" "0"
           "0" p2 "")
  (command ".undo" "e")
)


(defun zcadjh3 () ;水平标
  (command ".layer" "s" "02" "")
  (if (>= (car p2) (car p1))
    (zcadjh31)
    (zcadjh32)
  )
  (setq txt (itoa nox))
  (setq e1 nox)
  (command ".layer" "s" "14" "")
  (command ".text" "_C" p4 "0" txt)
  (command ".pline" pg pk p2 p3 "")
  (setq nox (+ nox 1))
  (setq no (itoa nox))
  (setq e1 (+ 1 e1))
)

(defun zcadjh31        ()
  (setq pg p3)
  (setq pk (list (+ (car p3) 2) (- (cadr p3) 2)))
  (setq p2 (list (+ (car p2) 16) (cadr p2)))
  (setq p3 (list (+ (car p2) 12) (cadr p2)))
  (setq p4 (list (/ (+ (car p2) (car p3)) 2) (+ (cadr p3) 1.5)))
)

(defun zcadjh32        ()
  (setq pg p3)
  (setq pk (list (- (car p3) 2) (- (cadr p3) 2)))
  (setq p2 (list (- (car p3) 4) (cadr p2)))
  (setq p3 (list (- (car p2) 12) (cadr p2)))
  (setq p4 (list (/ (+ (car p2) (car p3)) 2) (+ (cadr p3) 1.5)))
)

cancheung

收藏,谢谢!

yuun

试了一下,好象有错误