序号球（标注序号工具,lsp文件）

【实例截图】

【核心代码】

;;; 序号球==》 

(defun drawline (pt1 zh) 
(if (= zh "h") 
(progn (command "rectang" 
(list (  (car pt1) 8) (cadr pt1) (caddr pt1)) 
"@8,8" 
) 
(command "-array" "last" "" "r" "1" "10" "8") 
) 
(progn (command "rectang" 
(list (car pt1) (- (cadr pt1) 8) (caddr pt1)) 
"@8,-8" 
) 
(command "-array" "last" "" "r" "10" "1" "-8") 
) 
) 
) 

(defun deleteline (pt1 zh) 
(if (= zh "h") 
(ssget "_w" 
pt1 
(list (  (car pt1) 88) (  (cadr pt1) 8) (caddr pt1)) 
'((0 . "LWPOLYLINE")) 
) 
(ssget "_w" 
pt1 
(list (  (car pt1) 8) (- (cadr pt1) 88) (caddr pt1)) 
'((0 . "LWPOLYLINE")) 
) 
) 
(command "erase" "p" "") 
) 


(defun c:k () ; 画引线序号球 
(command "-layer" "s" "6标注" "") 
(setq old_os (getvar 'osmode)) 
(setq zh (getstring "\n横向<h>?纵向<z>? <h>：")) 
(if (= zh "") 
(setq zh "h") 
) 
(setq p1 (getpoint "\n基点：")) 
(setq p2 (getpoint "\n第二点：")) 
(setq pt1 p2) 
(drawline pt1 zh) 
(while p1 
(setq s (getstring "\n输入注释文字：")) 
(setq dis (distance p1 p2)) 
(setq ang (angle p1 p2)) 
(setq p3 (polar p1 ang (- dis 3.5))) 
(setvar 'osmode 0) 
(command "line" p1 p3 "") 
(command "circle" p2 "3.5") 
(setq th (getvar 'dimtxt)) 
(command "text" "j" "mc" p2 th "" s "") 
(setvar 'osmode old_os) 
(setq p1 (getpoint "\n基点：")) 
(if (= p1 nil) 
(progn 
(deleteline pt1 zh) 
(princ 
"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号" 
) 
(exit) 
(princ) 
) 
) 
(setq p2 (getpoint "\n第二点：")) 
) 
) 

(defun c:kk () ; 画方引线序号球 
(command "-layer" "s" "6标注" "") 
(setq old_os (getvar 'osmode)) 
(setq zh (getstring "\n横向<h>?纵向<z>? <h>：")) 
(if (= zh "") 
(setq zh "h") 
) 
(setq p1 (getpoint "\n基点：")) 
(setq p2 (getpoint "\n第二点：")) 
(setq pt1 p2) 
(drawline pt1 zh) 
(while p1 
(setvar 'osmode 0) 
(setq s (getstring "\n输入注释文字：")) 
(if (> (car p2) (car p1)) 
(if (> (cadr p2) (cadr p1)) 
(progn (setq p3 (list (- (car p2) 3.5) (- (cadr p2) 3.5) (caddr p2))) 
(command "rectang" p3 "@7,7") 
) 
(progn (setq p3 (list (- (car p2) 3.5) (  (cadr p2) 3.5) (caddr p2))) 
(command "rectang" p3 "@7,-7") 
) 
) 
(if (> (cadr p2) (cadr p1)) 
(progn (setq p3 (list (  (car p2) 3.5) (- (cadr p2) 3.5) (caddr p2))) 
(command "rectang" p3 "@-7,7") 
) 
(progn (setq p3 (list (  (car p2) 3.5) (  (cadr p2) 3.5) (caddr p2))) 
(command "rectang" p3 "@-7,-7") 
) 
) 
) 
(command "line" p1 p3 "") 
(setq th (getvar 'dimtxt)) 
(command "text" "j" "mc" p2 th "" s "") 
(setvar 'osmode old_os) 
(setq p1 (getpoint "\n基点：")) 
(if (= p1 nil) 
(progn 
(deleteline pt1 zh) 
(princ 
"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号" 
) 
(exit) 
(princ) 
) 
(setq p2 (getpoint "\n第二点：")) 
) 
) 
) 

(defun c:kkk () ; 画序号球 
(command "-layer" "s" "6标注" "") 
(setq old_os (getvar 'osmode)) 
(setq n (getint "\n设置起始值<1>")) 
(if (= n nil) 
(setq n 1) 
) 
(setvar 'osmode 32) 
(setq p1 (getpoint "\n基点：")) 
(while p1 
(setq p2 (list (- (car p1) 5) (- (cadr p1) 5) (caddr p1))) 
(setvar 'osmode 0) 
(command "circle" p2 "3.5") 
(command "text" "j" "mc" p2 "" "" n "") 
(setq n (1  n)) 
(setvar 'osmode 32) 
(setq p1 (getpoint "\n下一基点：")) 
) 
(setvar 'osmode old_os) 
(princ 
"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号" 
) 
(princ) 
) 

(defun c:kkkk () ; 填写序号 
(command "-layer" "s" "6标注" "") 
(setq old_os (getvar 'osmode)) 
(setq n1 (getint "\n设置起始值<1>")) 
(if (= n1 nil) 
(setq n1 1) 
) 
(setq n2 (getint "\n设置结束值<10>")) 
(if (= n2 nil) 
(setq n2 10) 
) 
(setvar 'osmode 32) 
(setq p1 (getpoint "\n基点：")) 
(setq p2 (getpoint "\n下一点：")) 
(setq p3 (list (/ (  (car p1) (car p2)) 2) 
(/ (  (cadr p1) (cadr p2)) 2) 
(caddr p1) 
) 
) 
(setvar 'osmode 0) 
(while (< n1 (1  n2)) 
(command "text" "j" "mc" p3 "" "" n1 "") 
(setq p3 (list (car p3) 
(  (cadr p3) (- (cadr p2) (cadr p1))) 
(caddr p1) 
) 
) 
(setq n1 (1  n1)) 
) 
(setvar 'osmode old_os) 
(princ 
"\n命令<k>画圆引线序号球 <kk>画方引线序号球 <kkk>画序号球 <kkkk>填写序号" 
) 
(princ) 
)