引线横线编号

s678z

下面这个程序是画机械图纸用的，序号需每次输入，可否参考球形编号，使第2次输入的序号依次增加，自动编号
(defun c:n (/ p1 p2 p3 txt)
  (if (= scalefactor nil) (setq scalefactor (getreal "\nPlease input scalefactor:")))(setvar "osmode" 0)  
  (setq p1 (getpoint "\nInput P1: "))
  (setvar "osmode" 512)
  (setq p2 (getpoint p1 "\nInput P2: "))
  (setvar "osmode" 0)
  (setq p3 (getpoint p2 "\nInput P3: "))
  (setq txt (getstring "\nNumber: "))
  (setq angle1 (angle p2 p3))
      (COND ((< (/ pi 2) angle1 (* (/ 3.0 2) pi)) (command "pline" p1 p2 (polar p2 pi (* 7 scalefactor)) "")
                                                (command "text" "j" "bc" (polar p2 2.737 (/ (* 7 scalefactor) 2)) (* 5 scalefactor) 0 txt ""))
   ((or (< (* (/ 3.0 2) pi) angle1 (* pi 2)) (< 0 angle1 (/ pi 2)) (EQUAL angle1 0))
                                                (command "pline" p1 p2 (polar p2 0 (* 7 scalefactor)) "")
                                                (command "text" "j" "bc" (polar p2 0.4(/ (* 7 scalefactor) 2)) (* 5 scalefactor) 0 txt ""))
    )
  (command "change" "l" "" "p" "la" "文字标注层" "")
  (princ)
  (setvar "osmode" 167)
)


参考程序
(defun c:no()
  (prompt  "\n*********neverstop->编号*********\n")
  (princ)
  (setvar "cmdecho" 0)
  (command "undo" "be")
  (SETQ A_GET (GETINT (STRCAT "\n请输入序号<" (RTOS (IF (= A nil)(setq A 1) A) 2 0) ">:")))
  (IF A_GET (setq A A_GET))
  (WHILE (setq  p1 (getpoint "\n请选择放置位置:"))
    (command  "circle" p1 6)
    (command "text" "J" "M" p1 5 0 A)
    (COMMAND "PICKBOX" "6")
    (SETQ A (+ 1 A))
  )
  (command ".undo" "e")
  (setvar "cmdecho" 1)
  (princ)
)

清风明月名字

谢谢各位楼主的奉献。

ZZXXQQ

游客，本帖隐藏的内容需要发帖数高于 5 才可浏览，你当前发帖数只有 0

LIULISHENG

学习了学习了

xyp1964

序号标注

springwillow

谢谢各位的大作，学习了！！

s678z

ZZXXQQ 发表于 2012-5-30 22:58
[/post]

谢谢ZZXXQQ大师，改进的程序很好用

s678z

xyp1964 发表于 2012-5-31 08:54
序号标注

e派工具箱(XCAD)一般人没有的，这程序通用性不强

vlisp2012

公布源码的话，通用性就强了

a8552065

似乎不錯用勒~感謝先

pxt2001

s678z 发表于 2012-6-1 08:21
e派工具箱(XCAD)一般人没有的，这程序通用性不强

还是独立的程序好，要不把部分引用的函数一起贴出来。