(vl-load-com)
(setq Mspace
(vla-get-ModelSpace
(vla-get-ActiveDocument (vlax-get-acad-object))
)
)
(princ "\n根据间距划分矩形工具加载成功,启动快捷键:wg")
(defun c:wg (/ ss1 sslen rect pt pts pt1 pt2 pt3 pt4 num num1 num2 num3
num4 l1 l2 l3 l4 ll r1 r2 ccolor obj)
(princ "\n选择需要划分网格的矩形:")
(setq ss1 (ssget '((0 . "LWPOLYLINE") (90 . 4)))
sslen (sslength ss1)
num1 0
)
(setq n (getdist "\n指定网格间距(直接输入或点取两点): "))
(while (not n)
(progn
(princ "\nERROR!没有输入网格间距!请重新输入间距!")
(setq n (getdist "\n指定网格间距(直接输入或点取两点)**按ESC可退出: "))
)
)
(repeat sslen
(progn
(setq rect (entget (ssname ss1 num1))
pts nil
obj(vlax-ename->vla-object (ssname ss1 num1))
ccolor(vla-get-Color obj)
)
(foreach num rect
(if (= (car num) 10)
(setq pts (append pts (list (cdr num))))
)
)
(cond ((= ccolor 1) (vla-put-color obj 2))
((/= ccolor 1) (vla-put-color obj 1))
)
(setq p1 (nth 0 pts)
p2 (nth 1 pts)
p3 (nth 2 pts)
p4 (nth 3 pts)
pt (getpoint "\n选取矩形的一个顶点:")
nn (getdist "\n指定网格间距(或按上一个): ")
l1 (distance pt p1)
l2 (distance pt p2)
l3 (distance pt p3)
l4 (distance pt p4)
ll (min l1 l2 l3 l4)
)
(if (/= nn nil)
(setq n nn)
)
(cond ((= ll l2)
(setq p4 p1
p1 p2
p2 p3
)
)
((= ll l3)
(setq p1 p3
p3 p4
p4 p2
p2 p3
)
)
((= ll l4)
(setq p2 p1
p1 p4
p4 p3
)
)
)
(setq l1 (distance p1 p2)
l2 (distance p1 p4)
r1 (angle p1 p2)
r2 (angle p1 p4)
num2 (fix (abs (/ l1 n)))
num3 (fix (abs (/ l2 n)))
num4 1
)
(repeat num2
(progn
(setq ptstart (vlax-3d-point (polar p1 r1 (* n num4)))
ptend (vlax-3d-point (polar p4 r1 (* n num4)))
num4 (+ num4 1)
)
(vla-addline Mspace ptstart ptend)
)
)
(setq num4 1)
(repeat num3
(setq ptstart (vlax-3d-point (polar p1 r2 (* n num4)))
ptend (vlax-3d-point (polar p2 r2 (* n num4)))
num4 (+ num4 1)
)
(vla-addline Mspace ptstart ptend)
)
(vla-put-color obj ccolor)
(setq num1 (+ num1 1)
n nn
nn nil)
)
)
(princ)
)