bios 发表于 2004-8-5 17:42:00

[求助]申请对标注的修改（等分）

如题：申请这样一个程序


        N等分标注尺寸。点取标注后就等分相应的标注尺寸。


由于尺寸很多，想批量标注。

xyp1964 发表于 2004-8-6 01:52:00

<FONT color=#000000>等分标注程序，请测试!</FONT>


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<BR>;;;dfbz.lsp 等分标注<BR>;;;* C:dfbz<BR>;;;-- <A href="mailto:XYP@bsedi.com" target="_blank" >XYP@bsedi.com</A><BR>;;;2004.08.05<BR>;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;<BR>(prompt "\n\r                                       加载等分标注程序。")<BR>;-------------------------------------------<BR>;;;主程序





(defun c:dfbz (/ ss n m pt0 pt1 pt2 ang dist)<BR>       (cmdla0)<BR>       (setvar "osmode"0)<BR>       (setq no3 (ureal 1 "" "\n\t等分数" no3))<BR>       (setq ss (entsel "\n\t选择需等分的标注"))<BR>       (if (and ss (&gt; no3 1) (= (dxf-s1 0 (car ss)) "DIMENSION"))<BR>                       (progn<BR>                                       (setq n 0 m 0)<BR>                                                       (setq s1 (car ss))<BR>        (mkla"dim-等分"3)<BR>        (setq pt2 (dxf-s1 13 s1) pt1 (dxf-s1 14 s1) pt0 (dxf-s1 10 s1))<BR>        (setq ang (angle pt1 pt2))<BR>        (setq dist (/ (distance pt1 pt2) no3))<BR>        (setq pt2 (polar pt1 ang dist))<BR>        (command "dim1" "ali" pt1 pt2 pt0 "")<BR>        (while (&lt; m (- no3 1))<BR>               (setq pt2 (polar pt2 ang dist))<BR>               (command "dim" "con" pt2 "" "e")<BR>               (setq m (+ 1 m))<BR>               )<BR>        (setq n (+ 1 n))<BR>                                       (entdel s1)<BR>                                       )<BR>                       )<BR>       (prin1)<BR>       (pxyp"dfbz                                       (等分标注)")<BR>       (cmdla1)<BR>       )


;;;-------------------------------------------<BR>;;;子程序<BR>;;;<BR>(defun CMDLA0 ()<BR>       (setq cmdech (GETVAR "CMDECHO"))<BR>       (setq oom (getvar "orthomode"))<BR>       (setq osm (getvar "osmode"))<BR>       (SETQ LA (getvar "clayer"))<BR>       (setvar "regenmode" 1)<BR>       (SETVAR "CMDECHO" 0)<BR>       )


;;;<BR>(defun CMDLA1 ()<BR>       (SETVAR "CMDECHO" cmdech)<BR>       (setvar "orthomode" oom)<BR>       (setvar "osmode" osm)<BR>       (setvar "clayer" LA)<BR>       (setvar "regenmode" 1)<BR>       )


;;;<BR>(defun ureal (bit kwd msg def / inp)<BR>       (if def<BR>                       (setq msg (strcat "\n" msg "&lt;" (rtos def 2) "&gt;: ")<BR>                                                                       bit (* 2 (fix (/ bit 2)))<BR>                       )<BR>                       (setq msg (strcat "\n" msg ": "))<BR>       )<BR>       (initget bit kwd)<BR>       (setq inp (getreal msg))<BR>       (if inp inp def)<BR>       )


;;;<BR>(Defun MKLA (a b)<BR>       (If (= (Tblsearch "layer" a) nil)<BR>                       (Command "layer" "m" a "c" b a "")<BR>                       (Command "layer" "t" a "s" a "c" b a "")<BR>                       )<BR>       )


;;;<BR>(defun dxf (code elist) (cdr (assoc code elist)))<BR>(defun dxf-s1(code elist) (dxf code (entget elist)))


<BR>;;;<BR>(DEFUN PXYP (TXT1)<BR>       (SETQ        TXT1 (STRCAT "\n\r                                       程序命令: "       TXT1 "                                       -- <A href="mailto:XYP@bsedi.com" target="_blank" >XYP@bsedi.com</A>"))<BR>       (PRINC TXT1)<BR>       (Princ)<BR>       );defun


;;;<BR>(pxyp"dfbz                                       (等分标注)")


;-------------------------------------------<BR>;;;END


bbo 发表于 2004-10-16 15:24:00

xie xie

hnfsf 发表于 2005-11-2 07:26:00

在标注线不等长的时候会乱来

userzhl 发表于 2006-2-14 11:25:00

没错，希望楼主再完善一下！

dengqiaqia 发表于 2007-6-10 00:34:00

最好用垂足的办法，通过判断是线性标注还是对齐标注反而将问题复杂化了，可以到XD力搜我的关于“类似天正..."的帖子，在vlisp里。

xiaofeifei 发表于 2012-5-10 20:29:24

有待改进啊。楼主

注册 发表于 2013-5-25 21:02:49

xyp1964 发表于 2004-8-6 01:52 static/image/common/back.gif
等分标注程序，请测试!




无法批量，呵呵
页: [1]
查看完整版本: [求助]申请对标注的修改（等分）