用grdraw函数在屏幕绘制矢量线

尹思颖

2. (defun c:t2 (/ gr p0 pt)
   
3.   (setq p0 (getpoint "指定起始点\n"))
   
4.   (prompt "\n移动鼠标指定路径，按任意键结束。")
   
5.   (while (and (setq gr (grread t 4 2))
   
6.            (= (car gr) 5)
   
7.          )
   
8.     (setq pt (cadr gr))
   
9.     (grdraw p0 pt 1)
   
10.     (setq p0 pt)
    
11.   )
    
12.   (princ)
    
13. )

(defun c:t2 (/ gr p0 pt) <br />   (setq p0 (getpoint "指定起始点\n"))<br />   (prompt "\n移动鼠标指定路径，按任意键结束。")<br />   (while (and (setq gr (grread t 4 2)) <br />            (= (car gr) 5)<br />          ) <br />     (setq pt (cadr gr))<br />     (grdraw p0 pt 1)<br />     (setq p0 pt)<br />   )<br />   (princ)<br /> )

hh_lj007

谢谢分享！

434939575

这个好玩。

xk15c

学习了，比较有用

janshyl

學習了感謝樓主分享

尹思颖

2. (defun c:gl (/ *error*_bak ang bignum ccolor clayer color ctextstyle dwg ename gr layer mspace ob ob+co_list obj osmode smallnum str text textnew)
   
3.   (vl-load-com)
   
4.   (setq *error*_bak *error* *error* *error*_yy
   
5.     dwg (vla-get-ActiveDocument (vlax-get-acad-object))
   
6.     mspace (vla-get-ModelSpace dwg)
   
7.     ctextstyle (getvar "TEXTSTYLE")
   
8.     clayer (getvar "CLAYER")
   
9.     ccolor (getvar "CECOLOR")
   
10.     osmode (getvar "OSMODE")
    
11.   )
    
12.   (setvar "CECOLOR" "1")
    
13.   (setvar "OSMODE" 0)
    
14.   (SetTextStyle dwg 35 0.8)
    
15.   (setq bignum (car (entsel "\n拾取大编号\n")))
    
16.   (while (or (not bignum)
    
17.            (null (vlax-property-available-p (setq ob (vlax-ename->vla-object bignum)) 'TextString))
    
18.            (/= (vlax-get-property ob 'Layer) "大编号")
    
19.          )
    
20.     (setq bignum (car (entsel "拾取大编号\n")))
    
21.   )
    
22.   (setq smallnum (getint "输入起始值<1>:\n"))
    
23.   (prompt "\n开始编号，并关联模板\n鼠标左键指定编号插入点，鼠标右键或键盘任意键结束\n")
    
24.   (if (null smallnum) (setq smallnum 1))
    
25.   (setq text (strcat (vlax-get-property (vlax-ename->vla-object bignum) 'TextString) "-"))
    
26.   (while (and (setq gr (grread t 4 2))
    
27.            (or (= (car gr) 5) (= (car gr) 3))
    
28.          )
    
29.     (if (setq ename (car (nentselp (cadr gr))))
    
30.       (progn
    
31.         (setq obj (vlax-ename->vla-object ename))
    
32.         (if (= (vlax-get-property obj 'ObjectName) "AcDbText")
    
33.           (progn
    
34.             (setq layer (vlax-get-property obj 'Layer)
    
35.               str (vlax-get-property obj 'TextString)
    
36.               color (vlax-get-property obj 'Color)
    
37.               ang (vlax-get-property obj 'Rotation)
    
38.               ob+co_list (cons (list obj color) ob+co_list)
    
39.             )
    
40.             (if (and (= layer "模板") (/= color 8)
    
41.                   (null (vl-string-search "EC" str))
    
42.                 )
    
43.               (progn
    
44.                 (vlax-put-property obj 'Color 8)
    
45.                 (setq textnew (strcat text (itoa smallnum)))
    
46.                 (vlax-put-property
    
47.                   (vlax-invoke-method mspace 'AddText
    
48.                     textnew
    
49.                     (vlax-3D-point (getpoint))
    
50.                     (vlax-make-variant 35 vlax-vbDouble)
    
51.                   )
    
52.                   'Rotation
    
53.                   (vlax-make-variant ang vlax-vbDouble)
    
54.                 )
    
55.                 (vlax-invoke-method obj 'SetXData
    
56.                   (vlax-safearray-fill
    
57.                     (vlax-make-safearray
    
58.                       vlax-vbInteger
    
59.                       '(0 . 1)
    
60.                     )
    
61.                     '(1001 1000)
    
62.                   )
    
63.                   (vlax-safearray-fill
    
64.                     (vlax-make-safearray
    
65.                       vlax-vbVariant
    
66.                       '(0 . 1)
    
67.                     )
    
68.                     (list "yy" textnew)
    
69.                   )
    
70.                 )
    
71.                 (setq smallnum (1+ smallnum))
    
72.               )
    
73.             )
    
74.           )
    
75.         )
    
76.       )
    
77.     )
    
78.   )
    
79.   (foreach x (DeleteSameAtom ob+co_list)
    
80.     (vlax-put-property (car x) 'Color (cadr x))
    
81.   )
    
82.   (setvar "TEXTSTYLE" ctextstyle)
    
83.   (setvar "CLAYER" clayer)
    
84.   (setvar "CECOLOR" ccolor)
    
85.   (setvar "OSMODE" osmode)
    
86.   (vlax-release-object dwg)
    
87.   (vlax-release-object mspace)
    
88.   (vlax-release-object ob)
    
89.   (vlax-release-object obj)
    
90.   (prompt "\n编号结束")
    
91.   (princ)
    
92. )
    
93. 
    
94. (defun *error*_yy (msg)
    
95.   (setq *error* *error*_bak)
    
96.   (foreach x (DeleteSameAtom ob+co_list)
    
97.     (vlax-put-property (car x) 'Color (cadr x))
    
98.   )
    
99.   (setvar "TEXTSTYLE" ctextstyle)
    
100.   (setvar "CLAYER" clayer)
     
101.   (setvar "CECOLOR" ccolor)
     
102.   (setvar "OSMODE" osmode)
     
103.   (prompt "\n编号结束")
     
104.   (princ msg)
     
105. )
     
106. 
     
107. ;;;删除表内重复元素
     
108. ;(DeleteSameAtom '(1 1 2 2 3))
     
109. (defun DeleteSameAtom(a / aa)
     
110.   (foreach tt a
     
111.     (if (null (member tt aa))
     
112.       (setq aa (append aa (list tt)))
     
113.     )
     
114.   )
     
115.   aa
     
116. )
     
117. 
     
118. ;设置编号将要使用的文字样式(_宋体)、和图层(小编号)
     
119. (defun SetTextStyle (dwg height wid / layer layers style styles)
     
120.   (setq styles (Vlax-Get dwg 'TextStyles)
     
121.     layers (Vlax-Get dwg 'Layers)
     
122.   )
     
123.   (if (null (tblsearch "style" "_宋体"))
     
124.     (progn
     
125.       (setq style (vlax-invoke-method styles 'add "_宋体"))
     
126.       (vlax-invoke-method style 'SetFont "宋体" :vlax-false :vlax-false 1 0)
     
127.     )
     
128.   )
     
129.   (if (null (tblsearch "layer" "小编号"))
     
130.     (setq layer (vlax-invoke-method layers 'add "小编号"))
     
131.   )
     
132.   (setq style (vla-Item styles "_宋体"))
     
133.   (vlax-put-property style 'height (vlax-make-variant height 5))
     
134.   (vlax-put-property style 'Width (vlax-make-variant wid 5))
     
135.   (vlax-release-object styles)
     
136.   (vlax-release-object style)
     
137.   (setvar "CLAYER" "小编号")
     
138.   (setvar "TEXTSTYLE" "_宋体")
     
139. )

(defun c:gl (/ *error*_bak ang bignum ccolor clayer color ctextstyle dwg ename gr layer mspace ob ob+co_list obj osmode smallnum str text textnew)<br />   (vl-load-com)<br />   (setq *error*_bak *error* *error* *error*_yy <br />     dwg (vla-get-ActiveDocument (vlax-get-acad-object))<br />     mspace (vla-get-ModelSpace dwg)<br />     ctextstyle (getvar "TEXTSTYLE")<br />     clayer (getvar "CLAYER")<br />     ccolor (getvar "CECOLOR")<br />     osmode (getvar "OSMODE")<br />   )<br />   (setvar "CECOLOR" "1")<br />   (setvar "OSMODE" 0)<br />   (SetTextStyle dwg 35 0.8)<br />   (setq bignum (car (entsel "\n拾取大编号\n")))<br />   (while (or (not bignum) <br />            (null (vlax-property-available-p (setq ob (vlax-ename->vla-object bignum)) 'TextString))<br />            (/= (vlax-get-property ob 'Layer) "大编号")<br />          )<br />     (setq bignum (car (entsel "拾取大编号\n")))<br />   )<br />   (setq smallnum (getint "输入起始值<1>:\n"))<br />   (prompt "\n开始编号，并关联模板\n鼠标左键指定编号插入点，鼠标右键或键盘任意键结束\n")<br />   (if (null smallnum) (setq smallnum 1))<br />   (setq text (strcat (vlax-get-property (vlax-ename->vla-object bignum) 'TextString) "-"))<br />   (while (and (setq gr (grread t 4 2)) <br />            (or (= (car gr) 5) (= (car gr) 3))<br />          ) <br />     (if (setq ename (car (nentselp (cadr gr)))) <br />       (progn <br />         (setq obj (vlax-ename->vla-object ename))<br />         (if (= (vlax-get-property obj 'ObjectName) "AcDbText") <br />           (progn <br />             (setq layer (vlax-get-property obj 'Layer) <br />               str (vlax-get-property obj 'TextString)<br />               color (vlax-get-property obj 'Color)<br />               ang (vlax-get-property obj 'Rotation)<br />               ob+co_list (cons (list obj color) ob+co_list)<br />             )<br />             (if (and (= layer "模板") (/= color 8)<br />                   (null (vl-string-search "EC" str))<br />                 ) <br />               (progn <br />                 (vlax-put-property obj 'Color 8)<br />                 (setq textnew (strcat text (itoa smallnum)))<br />                 (vlax-put-property <br />                   (vlax-invoke-method mspace 'AddText <br />                     textnew<br />                     (vlax-3D-point (getpoint))<br />                     (vlax-make-variant 35 vlax-vbDouble)<br />                   )<br />                   'Rotation <br />                   (vlax-make-variant ang vlax-vbDouble)<br />                 )<br />                 (vlax-invoke-method obj 'SetXData <br />                   (vlax-safearray-fill <br />                     (vlax-make-safearray <br />                       vlax-vbInteger<br />                       '(0 . 1)<br />                     )<br />                     '(1001 1000)<br />                   )<br />                   (vlax-safearray-fill <br />                     (vlax-make-safearray <br />                       vlax-vbVariant<br />                       '(0 . 1)<br />                     )<br />                     (list "yy" textnew)<br />                   )<br />                 )<br />                 (setq smallnum (1+ smallnum))<br />               )<br />             )<br />           )<br />         )<br />       )<br />     )<br />   )<br />   (foreach x (DeleteSameAtom ob+co_list) <br />     (vlax-put-property (car x) 'Color (cadr x))<br />   )<br />   (setvar "TEXTSTYLE" ctextstyle)<br />   (setvar "CLAYER" clayer)<br />   (setvar "CECOLOR" ccolor)<br />   (setvar "OSMODE" osmode)<br />   (vlax-release-object dwg)<br />   (vlax-release-object mspace)<br />   (vlax-release-object ob)<br />   (vlax-release-object obj)<br />   (prompt "\n编号结束")<br />   (princ)<br /> )<br /> <br /> (defun *error*_yy (msg) <br />   (setq *error* *error*_bak)<br />   (foreach x (DeleteSameAtom ob+co_list) <br />     (vlax-put-property (car x) 'Color (cadr x))<br />   )<br />   (setvar "TEXTSTYLE" ctextstyle)<br />   (setvar "CLAYER" clayer)<br />   (setvar "CECOLOR" ccolor)<br />   (setvar "OSMODE" osmode)<br />   (prompt "\n编号结束")<br />   (princ msg)<br /> )<br /> <br /> ;;;删除表内重复元素<br /> ;(DeleteSameAtom '(1 1 2 2 3))<br /> (defun DeleteSameAtom(a / aa)<br />   (foreach tt a<br />     (if (null (member tt aa))<br />       (setq aa (append aa (list tt)))<br />     )<br />   )<br />   aa<br /> )<br /> <br /> ;设置编号将要使用的文字样式(_宋体)、和图层(小编号)<br /> (defun SetTextStyle (dwg height wid / layer layers style styles) <br />   (setq styles (Vlax-Get dwg 'TextStyles) <br />     layers (Vlax-Get dwg 'Layers) <br />   )<br />   (if (null (tblsearch "style" "_宋体")) <br />     (progn <br />       (setq style (vlax-invoke-method styles 'add "_宋体"))<br />       (vlax-invoke-method style 'SetFont "宋体" :vlax-false :vlax-false 1 0)<br />     )<br />   )<br />   (if (null (tblsearch "layer" "小编号")) <br />     (setq layer (vlax-invoke-method layers 'add "小编号"))<br />   )<br />   (setq style (vla-Item styles "_宋体"))<br />   (vlax-put-property style 'height (vlax-make-variant height 5))<br />   (vlax-put-property style 'Width (vlax-make-variant wid 5))<br />   (vlax-release-object styles)<br />   (vlax-release-object style)<br />   (setvar "CLAYER" "小编号")<br />   (setvar "TEXTSTYLE" "_宋体")<br /> )