s678z 发表于 2012-5-29 09:52:24

引线横线编号

下面这个程序是画机械图纸用的，序号需每次输入，可否参考球形编号，使第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 (setqp1 (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)
)

清风明月名字 发表于 2012-5-31 09:09:51

谢谢各位楼主的奉献。

ZZXXQQ 发表于 2012-5-30 22:58:26


(defun c:n (/ p1 p2 p3 txt)
(if (= scalefactor nil)
(setq scalefactor (getreal "\nPlease input scalefactor:"))
)
(setq txt (getstring "\nNumber: "))
(while (and (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 angle1 (angle p2 p3))
(if (< (/ pi 2) angle1 (* 1.5 pi)) (progn
   (command "pline" p1 p2 (polar p2 pi (* 7 scalefactor)) "")
   (command "text" "j" "bc" (polar p2 2.737 (* 3.5 scalefactor)) (* 5 scalefactor) 0 txt "")
) (progn
   (command "pline" p1 p2 (polar p2 0 (* 7 scalefactor)) "")
   (command "text" "j" "bc" (polar p2 0.4 (* 3.5 scalefactor)) (* 5 scalefactor) 0 txt "")
))
(command "change" "l" "" "p" "la" "文字标注层" "")
(setq txt (itoa (1+ (atoi txt))))
)
(princ)
(setvar "OSMODE" 167)
)

LIULISHENG 发表于 2020-1-15 15:33:10

学习了学习了

xyp1964 发表于 2012-5-31 08:54:04

序号标注



springwillow 发表于 2012-5-31 09:32:58

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

s678z 发表于 2012-6-1 08:11:18

ZZXXQQ 发表于 2012-5-30 22:58 static/image/common/back.gif


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

s678z 发表于 2012-6-1 08:21:01

xyp1964 发表于 2012-5-31 08:54 static/image/common/back.gif
序号标注

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

vlisp2012 发表于 2012-6-2 16:58:00

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

a8552065 发表于 2012-6-7 15:29:00


似乎不錯用勒~感謝先

pxt2001 发表于 2012-6-8 09:52:42

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

还是独立的程序好，要不把部分引用的函数一起贴出来。
页: [1] 2
查看完整版本: 引线横线编号