[转帖]一个制图中件号标注的LSP程序，转为化工设备类制图而作.

<FONT face=宋体 size=2>;;一个标注件号的程序，可以选择不同标注方式，自动区分标注方向，自动累加序号。请使用前加载DOSLIB6,当然纯为了输入界面漂亮点，可以不用(需要修改原代码) 。<BR>;;本人原创。<BR></FONT>
<DIV style="MARGIN: 5px 20px 20px">
<DIV class=smallfont style="MARGIN-BOTTOM: 2px"><FONT face=宋体,verdana,arial,helvetica>代码:</DIV><RE class=alt2 style="BORDER-RIGHT: 1px inset; PADDING-RIGHT: 6px; BORDER-TOP: 1px inset; PADDING-LEFT: 6px; PADDING-BOTTOM: 6px; MARGIN: 0px; OVERFLOW: auto; BORDER-LEFT: 1px inset; WIDTH: 99%; PADDING-TOP: 6px; BORDER-BOTTOM: 1px inset"><FONT style="FONT-SIZE: 10pt" face="宋体,verdana, Airal,Helvetica,Geneva">
(defun c:BJH (/ 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"))
  (setvar "orthomode" 0)
  (setvar "CMDECHO" 0)
  (setvar "regenmode" 0)
  (princ "\n            =======  件号标注程序  =======      ")
  (princ
    "\n   当您输入件号A时,将进行向上重叠标注;当您输入件号B时,进行水平连续标注，X退出。"
  )
  (setq d "TK")
  (setq e1 1)
  (setvar "osmode" 0)
  (while d
    (setq no (dos_getstring "件号标注" "请输入件号：" (itoa e1)))
    (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 (&gt;= (car p2) (car p1))
        (setq p3 (list (+ (car p2) 12) (cadr p2)))
      )
      (if (&lt; (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 (&gt;= (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 (&gt;= (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)))
)</FONT></PRE></FONT></DIV>

<FONT face=Arial size=5>我将原码复制后保存为doslib6.lsp文件在2004中加载，但不知输入什么命令，请1楼详细说明使用方法。 </FONT>


<FONT face=Arial size=5>加载后，直接输入bjh即可。 </FONT>


<FONT size=5></FONT>