请帮忙编一个绘制号码球的小程序。
(defun c:hm (/ p1 p2 p3 hm)<BR> (command "line" )<BR> (setq p1 (getpoint "起点"))<BR> (command p1)<BR> (setq p2(getpoint "终点") )<BR> (command p2 "")<BR> (setq bj (getreal "圆半径"))<BR> (setq p3 (polar p2 (angle p1 p2) bj) )<BR> (command "circle" p3 bj)<BR> (setq hm(getstring "\n请输入零件号:"))<BR> (command "text" "j" "mc" p3 (* bj 0.8) 0 hm "")<BR>) (defun GetVal(fun msg key flag vla_tmp / val)(defun GetType(var / rVal)
(cond
((= (type var) 'STR) (setq rVal var))
((= (type var) 'INT) (setq rVal (rtos var)))
((= (type var) 'REAL) (setq rVal (rtos var)))
((= (type var) 'LIST) (setq rVal (vl-princ-to-string var)))
)
rVal
)
(if (or (not (eval vla_tmp)) (= (eval vla_tmp) ""))
(progn
(initget key (if flag flag ""))
(setq val (fun (strcat "\n" msg ":")))
)
(progn
(initget key (if flag (1- flag) ""))
(setq val (fun (strcat "\n" msg "<" (gettype (eval vla_tmp)) ">:")))
(if (or (not val) (= val "")) (setq val (eval vla_tmp)))
)
)
(set vla_tmp val)
)(defun MakeLine(pt1 pt2 / TextDxf)
(setq TextDxf '((0 . "LINE")
(100 . "AcDbEntity")
(67 . 0) (410 . "Model")
(100 . "AcDbLine")
)
)
(setq TextDxf (append TextDxf (list
(cons 10 pt1)
(cons 11 pt2)
;(cons 62 color)
'(210 0.0 0.0 1.0)
)
)
)
(entmake TextDxf)
(princ)
)(defun MakeCircle(pt R / ptInsert TextDxf)
(setq TextDxf '((0 . "CIRCLE") (100 . "AcDbEntity")
(67 . 0) (410 . "Model") (8 . "标注")
(100 . "AcDbCircle")
)
)
(setq TextDxf (append TextDxf (list
(cons 10 pt)
(cons 40 R)
'(210 0.0 0.0 1.0)
)
)
)
(entmake TextDxf)
(princ)
)(defun MakeText(pt1 str textheight / TextDxf)
(setq TextDxf '(
(0 . "TEXT")
(100 . "AcDbEntity") ; 需要所有 R12 之后版本的图元
(100 . "AcDbText") ; 将图元标记为 MTEXT
)
)
(setq TextDxf (append TextDxf (list
(cons 10 pt1)
(cons 1 str)
(cons 40 textheight)
;(cons 7 "HZ")
)
)
)
(entmake TextDxf)
(princ)
)(defun c:draw( / pt pt2 ent_lines ent_circles ptl2 pt_lst)
(setq pt (getpoint "\n输入起点:"))
(if (not TextSize)
(setq TextSize (getvar "textsize"))
)
(makeline pt (polar pt 0 1))
(setq ent_lines (entget (entlast)))
(makecircle pt textsize)
(setq ent_Circles (entget (entlast)))
(prompt "\n选择球位置")
(while (= (car (setq pt2 (grread 2 4))) 5)
(setq pt2 (cadr pt2))
(setq ptl2 (polar pt2 (angle pt2 pt) textsize))
(setq ent_lines (subst (cons 11 ptl2) (assoc 11 ent_lines) ent_lines))
(entmod ent_lines)
(setq ent_circles (subst (cons 10 pt2) (assoc 10 ent_circles) ent_circles))
(entmod ent_circles)
)
(GetVal getreal "输入球大小" "" 7 'TextSize)
(GetVal getstring "输入文字" "" 0 'Textstring)
(cond
((= (car pt2) 3)
(setq pt2 (cadr pt2))
(setq ptl2 (polar pt2 (angle pt2 pt) textsize))
(setq ent_lines (subst (cons 11 ptl2) (assoc 11 ent_lines) ent_lines))
(entmod ent_lines)
(setq ent_circles (subst (cons 10 pt2) (assoc 10 ent_circles) ent_circles))
(setq ent_circles (subst (cons 40 textsize) (assoc 40 ent_circles) ent_circles))
(entmod ent_circles)
(setq pt_lst (textbox (list '(0 . "TEXT") (cons 1 textstring) (cons 40 textsize))))
(if (/= textstring "")
(maketext
(list (- (car pt2) (/ (- (caadr pt_lst) (caar pt_lst)) 2.0)) (- (cadr pt2) (/ (- (cadadr pt_lst) (cadar pt_lst)) 2.0)))
;(polar pt2 (angle (cadr pt_lst) (car pt_lst)) (distance (car pt_lst) (cadr pt_lst)))
textstring
textsize)
)
)
)
(princ)
) 不要这么复杂嘛，简单一点，我一点都看不懂，注释多点嘛， 我来试一下，版主，你看一下，行吗？
(defun c:yuanqiu(/ pt1 pt2 d text)
(setq pt1(getpoint"\n输入引线起点：")
(setq pt2(getpoint"\n输入号码球放置点：")
(setq d(getdist"\n输入号码球的直径：")<BR>(setq text(getstring "\n请输入零件号: ")
(command"line" pt1 <BR>我写不下去了，我知道问题在哪，我不知道怎么使两个我已经画好的图形剪切，我是想先画一直线，后画一圆，然后把圆里面的直线剪掉， (Defun c:test()<BR> (if (= (getvar "cmdecho") 1)(setvar "cmdecho"0))<BR> (if (/= (setq os (getvar "osmode")) 0) (setvar "osmode" 0))<BR> (setq ap(getpoint "\n起點:")<BR> bp(getpoint "\n球的中心點:")<BR> cr(getdist "\n球的半徑:")<BR> text (getstring "\n數值:")<BR> ang (angle ap bp)<BR> abd (distance ap bp))<BR> (command ".line" ap (polar ap ang (- abd cr)) "")<BR> (command ".circle" bp cr)<BR> (command ".text" "j" "mc" bp "" "" text "")<BR> (if (= (getvar "cmdecho") 0)(setvar "cmdecho"1))<BR> (setvar "osmode" os)<BR> (princ)) 插入块的方法效率不更高么？ 如果程序写好了，插入块就显得麻烦了，因为好改变圆的大小，文字内容等，
to 晓雨：程序这么长是因为考虑了很多问题过程的动态显示、输入的人性化考虑、避免使用command命令（这个不是很必要）以及最后圆的大小和文字大小及位置，你可以试试楼上几位的程序和我的程序的效果就知道了。。。 F8的很好，没的说了。要是每次输入零件号时都比上次递增一位，就更好了。 找到相应位置，加上中间那句(if (and ....))
(GetVal getreal "输入球大小" "" 7 'TextSize)<BR> (if (and textstring (= (type (read textstring)) 'INT)) (setq textstring (rtos (1+ (read textstring)))))<BR> (GetVal getstring "输入文字" "" 0 'Textstring)
页:
[1]
2