[测试]：一个标网格线坐标的程序。

eachy

2. 
   
3. ;|
   
4. 一个标网格线交点的程序，用于CAD2002  + 晓东工具箱，请在WCS下使用
   
5. |;
   
6. ($xdrx_load "xdlsp.lsp")
   
7. (if (not $xdtb_globle_scale)
   
8.   (setq $xdtb_globle_scale 1.)
   
9. )
   
10. (defun c:xdtb_dmwg (/ ss pts e)
    
11.   (if (setq e (xdrx_entsel "\n拾取网格线实体: "))
    
12.     (progn
    
13.       (xdrx_begin)
    
14.       (xdrx_sysvar_push "osmode" "textstyle" "dimzin")
    
15.       (setvar "osmode" 0)
    
16.       (setvar "dimzin" 0)
    
17.       ($xdlsp_checkfont)
    
18.       (setvar "textstyle" "xdtb_efont")
    
19.       (xdrx_setenttodb (car e))
    
20.       (princ "\拾取标注范围(回车全标)....")
    
21.       (if (not
    
22.             (setq ss
    
23.                    (ssget (list '(0 . "*line") (cons 8 (xdrx_getentdxf 8))))
    
24.             )
    
25.           )
    
26.         (setq ss
    
27.                (ssget "x"
    
28.                       (list '(0 . "*line") (cons 8 (xdrx_getentdxf 8)))
    
29.                )
    
30.         )
    
31.       )
    
32.       (setq pts (xdrx_getinters ss 0))
    
33.       (mapcar '(lambda (x / $x $y $px $py)
    
34.                  (setq $x  (rtos (cadr x) 2 0)
    
35.                        $y  (rtos (car x) 2 0)
    
36.                        $px (polar x (* 0.75 pi) (* 2 $xdtb_globle_scale))
    
37.                        $py (polar x (* 0.25 pi) (* 2 $xdtb_globle_scale))
    
38.                  )
    
39.                  (vl-cmdf ".text"
    
40.                           "j"
    
41.                           "br"
    
42.                           $px
    
43.                           (* 3. $xdtb_globle_scale)
    
44.                           "0"
    
45.                           $x
    
46.                  )
    
47.                  (vl-cmdf ".text"
    
48.                           "j"
    
49.                           "tl"
    
50.                           $py
    
51.                           (* 3. $xdtb_globle_scale)
    
52.                           "90"
    
53.                           $y
    
54.                  )
    
55.                )
    
56.               pts
    
57.       )
    
58.       (xdrx_sysvar_pop)
    
59.       (xdrx_end)
    
60.       (princ)
    
61.     )
    
62.   )
    
63. )
    

<br /> ;|<br /> 一个标网格线交点的程序，用于CAD2002  + 晓东工具箱，请在WCS下使用<br /> |;<br /> ($xdrx_load "xdlsp.lsp")<br /> (if (not $xdtb_globle_scale)<br />   (setq $xdtb_globle_scale 1.)<br /> )<br /> (defun c:xdtb_dmwg (/ ss pts e)<br />   (if (setq e (xdrx_entsel "\n拾取网格线实体: "))<br />     (progn<br />       (xdrx_begin)<br />       (xdrx_sysvar_push "osmode" "textstyle" "dimzin")<br />       (setvar "osmode" 0)<br />       (setvar "dimzin" 0)<br />       ($xdlsp_checkfont)<br />       (setvar "textstyle" "xdtb_efont")<br />       (xdrx_setenttodb (car e))<br />       (princ "\拾取标注范围(回车全标)....")<br />       (if (not<br />             (setq ss<br />                    (ssget (list '(0 . "*line") (cons 8 (xdrx_getentdxf 8))))<br />             )<br />           )<br />         (setq ss<br />                (ssget "x"<br />                       (list '(0 . "*line") (cons 8 (xdrx_getentdxf 8)))<br />                )<br />         )<br />       )<br />       (setq pts (xdrx_getinters ss 0))<br />       (mapcar '(lambda (x / $x $y $px $py)<br />                  (setq $x  (rtos (cadr x) 2 0)<br />                        $y  (rtos (car x) 2 0)<br />                        $px (polar x (* 0.75 pi) (* 2 $xdtb_globle_scale))<br />                        $py (polar x (* 0.25 pi) (* 2 $xdtb_globle_scale))<br />                  )<br />                  (vl-cmdf ".text"<br />                           "j"<br />                           "br"<br />                           $px<br />                           (* 3. $xdtb_globle_scale)<br />                           "0"<br />                           $x<br />                  )<br />                  (vl-cmdf ".text"<br />                           "j"<br />                           "tl"<br />                           $py<br />                           (* 3. $xdtb_globle_scale)<br />                           "90"<br />                           $y<br />                  )<br />                )<br />               pts<br />       )<br />       (xdrx_sysvar_pop)<br />       (xdrx_end)<br />       (princ)<br />     )<br />   )<br /> )<br />

chenhang1203

谢谢老大，很需要这个东西啊。只是程序总要自带一个字体进来，有点讨厌，为什么不能用当前字体呢？不过已经很喜欢了啊，再谢谢你的工作！

3602705

有演示吗

寒梅

用了一下感觉不错,但有个问题,没有比例的设置,文字不能大小不能随比例变化,在1代表1米的图纸中,文字还看得清楚,在1000代表1米的图纸中,标注文字就太小了

eachy

最初由 寒梅 发布
[B]用了一下感觉不错,但有个问题,没有比例的设置,文字不能大小不能随比例变化,在1代表1米的图纸中,文字还看得清楚,在1000代表1米的图纸中,标注文字就太小了 [/B]

1000下这样控制 运行程序前输入 (setq $xdtb_globle_scale 1000.) 其他比例类推

xiaoyanyan

推荐：仓心圆也有个程序。网址：
http://fgold.8u8.com/lisp/lisp/fgzhuji/fgzhuji.htm
欢迎大家去看看！
-----------------------------好东西当然大家分享

;;;方格网注记
(defun c:fgzhuji()
  (setvar "cmdecho" 0)
  (setvar "osmode" 0)
  (graphscr)
  (setq bili nil)
  (initget (+ 2 4))
  (setq bili (getreal "\n比例尺1:[1000]"))
  (if (= bili nil) (setq bili 1000.0))
  (setq sc (/ 1000 bili))
  (while (> sc 0)
   (setq pt (getpoint "\n请于方格网'十'附近指定注记点："))
   (setq x (car pt) y (cadr pt))
   (setq a (* (fix (/ x (/ 100 sc))) (/ 100 sc)))
   (if (< x 0) (setq b (- a (/ 100 sc))) (setq b (+ a (/ 100 sc))))
   (if (< (abs (- x a)) (abs (- b x))) (setq x0 a) (setq x0 b))
   (setq a (* (fix (/ y (/ 100 sc))) (/ 100 sc)))
   (if (< y 0) (setq b (- a (/ 100 sc))) (setq b (+ a (/ 100 sc))))
   (if (< (abs (- y a)) (abs (- b y))) (setq y0 a) (setq y0 b))
   (setq x1 (+ x0 (/ 7 sc)))
   (setq y1 (- y0 (/ 1.25 sc)))
   (setq x2 x0)
   (setq y2 (- y0 (/ 8.25 sc)))
   (setq pt1 (list x1 y1))
   (setq pt2 (list x2 y2))
   (setq texthigh (/ 2.5 sc))
   (setq strx0 (rtos x0 2 0))
   (setq stry0 (rtos y0 2 0))
   (command "layer" "m" "fgw" "")
   (command "text" pt1 texthigh "" stry0)
   (command "text" pt2 texthigh "" strx0)
  )
  (setvar "cmdecho" 1)
  (princ)
  )

myfreemind

好程序，谢谢楼主！！

xiaoyanyan

myfreemind ：
         不用谢我，希望你能继续完善发给我的“文本格式的一组坐标点调入AutoCAD”程序，
并把调入文件的具体格式告诉我。
      谢谢了！

myfreemind

调入文件的格式就是你说的那种格式！