请明经的CAD高手帮忙！！！
请帮我编一个程序，要求如下：1、可以预先设定圆的直径（7mm乘以图形的标注比例）
2、可以预先设定字高（3mm乘以图形的标注比例）
3、箭头、圆、字三个对象必须是一个整体
4、拉伸时箭头仍然通过圆的中心
比如：我的图形比例是10，那么我就可以预先设定圆的直径为70，字高为30
请说说箭头及直线的要求，如何拉伸？
请说说箭头及直线的要求，如何拉伸？请说说箭头及直线的要求，如何拉伸？
请说说箭头及直线的要求，如何拉伸？ stretch命令 参考，这个有点像;本程序创建旁注线并将文字封在一个“气泡”里。<BR>;如果字符少于3个，气泡是一个圆环，如果多于或等于3个字符，气泡是一个椭园。<BR>;文本和气泡以同样角度延伸于旁注线，“气泡”放置到指定的层。
(defun C:qp<BR> (/ tmp ts th nh ip sp ali le errexit bx acadver<BR> LBLOCK BLAYER TEXTGAP CHARWIDTH BWIDTH)<BR> (setq LBLOCK T) ;“气泡”创建为块，除非这里LBLOCK设为nil<BR> (setq BLAYER "sdim") ;放置“气泡”的图层："XXXX"=放置在层XXXX，nil=使用当前层<BR> (setq TEXTGAP 0.8) ;希望的文本和“气泡”的间距（1单位=尺寸文本高）<BR> (setq CHARWIDTH 1.0) ;1个单位高字符的平均宽度（仅用于R11）<BR> (setq BWIDTH 0.04) ;“气泡”线宽：nil=无宽度（1单位=尺寸文本高，如果气泡是椭圆，无效，且在R13中PELLIPSE=0）<BR> (setq acadver (read (substr (getvar "ACADVER") 1 2)))<BR> (if (/= (type acadver) 'INT) (setq acadver 0))
(defun errexit (s)<BR> (princ "\n错误： ")<BR> (princ s)<BR> (restore)<BR> )
(defun bx ()<BR> (if le (entdel le))<BR> (setvar "CMDECHO" (car oldvar))<BR> (setvar "BLIPMODE" (cadr oldvar))<BR> (setvar "OSMODE" (nth 2 oldvar))<BR> (setvar "CLAYER" (nth 3 oldvar))<BR> (setvar "DONUTID" (nth 4 oldvar))<BR> (setvar "DONUTOD" (nth 5 oldvar))<BR> (setq *error* olderr)<BR> (princ)<BR> )<BR> ;Main Program<BR> (setq T (not nil))<BR> (setq olderr *error*<BR> restore bx<BR> *error* errexit<BR> )<BR> (setq oldvar <BR> (list <BR> (getvar "CMDECHO") <BR> (getvar "BLIPMODE") <BR> (getvar "OSMODE")<BR> (getvar "CLAYER")<BR> (getvar "DONUTID")<BR> (getvar "DONUTOD")<BR> )<BR> )<BR> (setvar "CMDECHO" 0)<BR> (setvar "BLIPMODE" 0)<BR> (setvar "OSMODE" 0)<BR> (terpri)<BR> (if (= acadver 11) ;是R11吗？
(defun textbox (elist) ;如果是，定义一个定制的文本框函数<BR> (list<BR> '(0 0 0)<BR> (list<BR> (* (strlen (cdr (assoc 1 elist))) (cdr (assoc 40 elist)) CHARWIDTH)<BR> (cdr (assoc 40 elist))<BR> 0<BR> )<BR> )<BR> )<BR> )<BR> (if <BR> (= 0 <BR> (setq th <BR> (cdr (assoc '40 (tblsearch "style" (getvar "textstyle"))))<BR> )<BR> ) <BR> (setq nh (setq th (* (getvar "DIMTXT") (getvar "DIMSCALE"))))<BR> (setq nh nil)<BR> )<BR> (if BLAYER <BR> (command "._LAYER"<BR> (if (tblsearch "LAYER" BLAYER) "_S" "_M")<BR> BLAYER<BR> ""<BR> )<BR> )<BR> (if (setq ip (setq sp (getpoint "拾取旁注线起点： ")))<BR> (progn<BR> (entmake (list '(0 . "POINT") (cons 10 (trans sp 1 0))))<BR> (setq le (entlast))<BR> (command "._DIM1" "_LEADER")<BR> (setvar "CMDECHO" 1)<BR> (command sp)<BR> (while<BR> (progn <BR> (initget 128)<BR> (setq sp (getpoint sp))<BR> )<BR> (command sp)<BR> )<BR> (setvar "CMDECHO" 0)<BR> (command)<BR> (setq sp (trans (cdr (assoc '11 (entget (entlast)))) 0 1))<BR> (setq ali (angle (trans (cdr (assoc '10 (entget (entlast)))) 0 1) sp)) <BR> (setq tmp (getstring T "键入文本： "))<BR> (setq ts (textbox (list (cons '1 tmp) (cons '40 th))))<BR> (setq ts <BR> (list <BR> (+ (- (car (cadr ts)) (car (car ts))) (* 2 TEXTGAP th))<BR> (* 3 TEXTGAP th)<BR> )<BR> )<BR> (command "._TEXT"<BR> "_M"<BR> (polar <BR> sp <BR> ali <BR> (* 0.5 (if (<= (strlen tmp) 2) (cadr ts) (car ts))) <BR> )<BR> )<BR> (if nh (command th))<BR> (command <BR> (if (<= (strlen tmp) 2)<BR> '0<BR> (rtd<BR> (if <BR> (and (< ali (* 3 (/ pi 2))) (> ali (/ pi 2))) <BR> (+ ali pi) <BR> ali<BR> )<BR> )<BR> )<BR> tmp<BR> )<BR> (if (<= (strlen tmp) 2)<BR> (command "._DONUT" <BR> (cadr ts) <BR> (cadr ts) <BR> (polar <BR> sp <BR> ali <BR> (* 0.5 (if (<= (strlen tmp) 2) (cadr ts) (car ts))) <BR> )<BR> ""<BR> )<BR> (command "._ELLIPSE" <BR> sp <BR> (polar sp ali (if (<= (strlen tmp) 2) (cadr ts) (car ts)))<BR> (/ (cadr ts) 2)<BR> )<BR> )<BR> (if <BR> (and BWIDTH<BR> (> BWIDTH 0)<BR> (not (and (= acadver 13) (zerop (getvar "PELLIPSE")) (> (strlen tmp) 2)))<BR> ) <BR> (command "._PEDIT" (entlast) "W" (* th BWIDTH) "X")<BR> )<BR> (if LBLOCK<BR> (progn<BR> (entmake (list <BR> (cons '0 "BLOCK") <BR> (cons '2 "*U") <BR> (cons '70 1) <BR> (cons '10 ip)<BR> ))<BR> (setq th (setq tmp le))<BR> (while (setq tmp (entnext tmp))<BR> (entmake (entget tmp))<BR> ) <BR> (setq tmp (entmake (list (cons '0 "ENDBLK"))))<BR> (while (setq th (entnext th))<BR> (entdel th)<BR> ) <BR> (entdel le)<BR> (setq le nil)<BR> (entmake (list <BR> (cons '0 "INSERT") <BR> (cons '2 tmp) <BR> (cons '10 ip)<BR> ))<BR> )<BR> ) <BR> ) <BR> ) <BR> (restore)<BR>)
页:
[1]