;自己优化一下，碰到多条线时暂不处理
(defun c:1 (/ mid dxf ss-y ss-x MINDIST ss ss1 name pt pt1 dis i test)
(defun MID (PT1 PT2)
(list
(* 0.5 (+ (nth 0 PT1) (nth 0 PT2)))
(* 0.5 (+ (nth 1 PT1) (nth 1 PT2)))
)
)
(defun dxf (i name /)
(cdr (assoc i (entget name)))
)
(defun ss-y (pt dis / pt1 pt2)
(setq pt1 (list (- (car pt) dis) (- (cadr pt) 0.5)))
(setq pt2 (list (+ (car pt) dis) (+ (cadr pt) 0.5)))
(if (setq ss1 (ssget "c" pt1 pt2 '((0 . "LINE"))))
(if (and (= (sslength ss1) 1)
(setq name (ssname ss1 0))
(or
(equal (angle (dxf 10 name) (dxf 11 name))
(* 0.5 pi)
0.0001
)
(equal (angle (dxf 10 name) (dxf 11 name))
(* 1.5 pi)
0.0001
)
)
)
T
nil
)
)
)
(defun ss-x (pt dis / pt1 pt2)
(setq pt1 (list (- (car pt) 0.5) (- (cadr pt) dis)))
(setq pt2 (list (+ (car pt) 0.5) (+ (cadr pt) dis)))
(if (setq ss1 (ssget "c" pt1 pt2 '((0 . "LINE"))))
(if (and (= (sslength ss1) 1)
(setq name (ssname ss1 0))
(or
(equal (angle (dxf 10 name) (dxf 11 name))
0
0.0001
)
(equal (angle (dxf 10 name) (dxf 11 name))
pi
0.0001
)
)
)
T
nil
)
)
)
(defun MINDIST (PT NAME /)
(vlax-curve-getclosestpointto
(vlax-ename->vla-object name)
pt
t
)
)
(if (setq ss (ssget '((0 . "INSERT"))))
(progn
(setvar "osmode" 0)
(setq i -1)
(while (setq name (ssname ss (setq i (1+ i))))
(setq pt (trans (dxf 10 name) 0 1)
test T
dis 0
)
(while test
(setq dis (+ dis 10))
(if (> dis 2000)
(setq test nil)
(if (ss-y pt dis)
(progn
(setq pt1 (trans (MINDIST (trans pt 1 0) name) 0 1))
(if (> (distance pt pt1) 0)
(command "dimlinear" pt pt1 (mid pt pt1))
)
(setq test nil)
)
)
)
)
(setq test T
dis 0
)
(while test
(setq dis (+ dis 10))
(if (> dis 2000)
(setq test nil)
(if (ss-x pt dis)
(progn
(setq pt1 (trans (MINDIST (trans pt 1 0) name) 0 1))
(if (> (distance pt pt1) 0)
(command "dimlinear" pt pt1 (mid pt pt1))
)
(setq test nil)
)
)
)
)
)
)
)
)
597
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
