请各位老大，帮忙搞个画十字交叉线小程序。谢谢
框选矩形和圆或者多线，能自动画出中心的十字交叉线。能区分那矩形的转角。能用于用户坐标系。那中心的十字交叉线长度能记忆，那长度能用户定义。最好的是能识别那不规则的围合多线的中心。不是那质心。网上找的那些不能用于用户坐标。 网上找的那些不能识别那转角，有的不能一下框选，有的那长度不能自定义并记忆 找到个合适的，只是不能框选。老大帮忙把那对圆，矩形改成可以框选就爽了。(defun c:zx ()
(vl-load-com)
(setq ent0 (car (entsel "\n 请选择直线、圆、圆弧、椭圆和矩形:")))
(setq ent1 (entget ent0))
(setq name (cdr (assoc 0 ent1)))
(setq os (getvar "osmode"))
(setq cmd (getvar "CMDECHO"))
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
;;;所选物体是直线
(cond ((= name "LINE")
(setq ent2 (entget (car (entsel "\n 请选择另一条直线:"))))
(setq point10 (cdr (assoc 10 ent1))
point11 (cdr (assoc 11 ent1))
point20 (cdr (assoc 10 ent2))
point21 (cdr (assoc 11 ent2))
) ;_求两直线2个端点的坐标
(setq ang1 (angle point10 point11)
ang2 (angle point20 point21)
)
(if (or (equal (abs (- ang1 ang2)) pi 0.0001)
(= (- ang1 ang2) 0)
)
(progn
(setq obj (vlax-Ename->vla-object ent0))
(setq p0 (vlax-curve-getClosestPointTo obj point20))
(setq inter-point
(mapcar '(lambda (a b) (/ (+ a b) 2))
p0
point20
)
)
(print inter-point)
(command "offset" "T" ent0 inter-point "")
)
(progn
(setq inter-point (inters point10 point11 point20 point21 nil)) ;_求得两直线的交点
(setq p0 (polar inter-point (angle inter-point point10) 10)
p1 (polar inter-point (angle inter-point point20) 10)
) ;_求2个虚拟点
;直线端点离交点最近判断
(if (> (distance inter-point point10)
(distance inter-point point11)
)
(setq p10 point11
p11 point10
)
(setq p10 point10
p11 point11
)
)
(if (> (distance inter-point point20)
(distance inter-point point21)
)
(setq p20 point21
p21 point20
)
(setq p20 point20
p21 point21
)
)
;求角平分线上的虚拟点
(setq inter-point0
(mapcar '(lambda (a b) (/ (+ a b) 2)) p0 p1)
)
(setq p00 (inters p10 p20 inter-point inter-point0 nil)
p01 (inters p11 p21 inter-point inter-point0 nil)
)
(command "LINE" p00 p01 "")
)
)
)
;;;所选物体是圆
((or
(= name "CIRCLE")
(= name "ARC")
)
(setq point (cdr (assoc 10 ent1)))
(setq r (cdr (assoc 40 ent1)))
(setq l (+ r 300))
(setq x (car point)
y (cadr point)
)
(setq point10 (list (- x l) y))
(setq point11 (list (+ x l) y))
(setq point20 (list x (+ y l)))
(setq point21 (list x (- y l)))
(command "line" point10 point11 "")
(command "line" point20 point21 "")
)
;;;所选物体是圆弧
;;((= name "ARC")
;; )
;;;所选物体是椭圆
((= name "ELLIPSE")
(setq obj (vlax-Ename->Vla-Object ent0))
(setq center-point (vlax-safearray->list
(vlax-variant-value (vla-get-Center obj))
)
StartPoint (vlax-safearray->list
(vlax-variant-value (vla-get-StartPoint obj))
)
MajorRadius(vla-get-MajorRadius obj)
MinorRadius(vla-get-MinorRadius obj)
)
(setq ang1 (angle center-point startpoint)
ang2 (+ ang1 (* pi 0.5))
)
(setq point10 (polar center-point ang1 (+ MajorRadius 300))
point11 (polar center-point
(+ ang1 pi)
(+ MajorRadius 300)
)
point20 (polar center-point ang2 (+ MinorRadius 300))
point21 (polar center-point
(+ ang2 pi)
(+ MinorRadius 300)
)
)
(command "LINE" point10 point11 "")
(command "LINE" point20 point21 "")
)
;;;所选物体是矩形
((= name "LWPOLYLINE")
(setq obj (vlax-Ename->Vla-Object ent0))
(setq point (vlax-safearray->list
(vlax-variant-value (vla-get-Coordinates obj))
)
)
(if (= (length point) 8)
(progn
(setq p1 (list (nth 0 point) (nth 1 point))
p2 (list (nth 2 point) (nth 3 point))
p3 (list (nth 4 point) (nth 5 point))
p4 (list (nth 6 point) (nth 7 point))
)
(setq center-point (mapcar '(lambda (a b) (/ (+ a b) 2))
p1
p3
)
ang1 (angle p1 p2)
ang2 (angle p1 p4)
d1 (distance p1 p2)
d2 (distance p1 p4)
)
(setq point10 (polar center-point ang1 (+ (* d1 0.5) 300))
point11 (polar center-point
(+ ang1 pi)
(+ (* d1 0.5) 300)
)
point20 (polar center-point ang2 (+ (* d2 0.5) 300))
point21 (polar center-point
(+ ang2 pi)
(+ (* d2 0.5) 300)
)
)
(command "LINE" point10 point11 "")
(command "LINE" point20 point21 "")
)
(princ "\n所选物体不是矩形,请重新选择!")
)
)
(T
(princ
"\n 所选物体不属于直线、圆、圆弧、椭圆和矩形之内,请重新选择!"
)
)
)
(setvar "OSMODE" os)
(setvar "cmdecho" cmd)
(princ)
) 本帖最后由 Andyhon 于 2011-7-15 12:39 编辑
(defun zx_1 ()
(setq ent1 (entget ent0))
(setq name (cdr (assoc 0 ent1)))
(setq os (getvar "osmode"))
(setq cmd (getvar "CMDECHO"))
(setvar "cmdecho" 0)
(setvar "OSMODE" 0)
;; 所选物体是直线
(cond
((= name "LINE")
(setq ent2 (entget (car (entsel "\n 请选择另一条直线:"))))
(setq point10 (cdr (assoc 10 ent1))
point11 (cdr (assoc 11 ent1))
point20 (cdr (assoc 10 ent2))
point21 (cdr (assoc 11 ent2))
) ;_求两直线2个端点的坐标
(setq ang1 (angle point10 point11)
ang2 (angle point20 point21)
)
(if (or (equal (abs (- ang1 ang2)) pi 0.0001)
(= (- ang1 ang2) 0)
)
(progn
(setq obj (vlax-Ename->vla-object ent0))
(setq p0 (vlax-curve-getClosestPointTo obj point20))
(setq inter-point
(mapcar '(lambda (a b) (/ (+ a b) 2))
p0
point20
)
)
(print inter-point)
(command "offset" "T" ent0 inter-point "")
)
(progn
(setq inter-point (inters point10 point11 point20 point21 nil)) ;_求得两直线的交点
(setq p0 (polar inter-point (angle inter-point point10) 10)
p1 (polar inter-point (angle inter-point point20) 10)
) ;_求2个虚拟点
;直线端点离交点最近判断
(if (> (distance inter-point point10)
(distance inter-point point11)
)
(setq p10 point11
p11 point10
)
(setq p10 point10
p11 point11
)
)
(if (> (distance inter-point point20)
(distance inter-point point21)
)
(setq p20 point21
p21 point20
)
(setq p20 point20
p21 point21
)
)
;求角平分线上的虚拟点
(setq inter-point0
(mapcar '(lambda (a b) (/ (+ a b) 2)) p0 p1)
)
(setq p00 (inters p10 p20 inter-point inter-point0 nil)
p01 (inters p11 p21 inter-point inter-point0 nil)
)
(command "LINE" p00 p01 "")
)
)
)
;; 所选物体是圆
((or
(= name "CIRCLE")
(= name "ARC")
)
(setq point (cdr (assoc 10 ent1)))
(setq r (cdr (assoc 40 ent1)))
(setq l (+ r 300))
(setq x (car point)
y (cadr point)
)
(setq point10 (list (- x l) y))
(setq point11 (list (+ x l) y))
(setq point20 (list x (+ y l)))
(setq point21 (list x (- y l)))
(command "line" point10 point11 "")
(command "line" point20 point21 "")
)
;; 所选物体是圆弧
;;((= name "ARC")
;; )
;; 所选物体是椭圆
((= name "ELLIPSE")
(setq obj (vlax-Ename->Vla-Object ent0))
(setq center-point (vlax-safearray->list
(vlax-variant-value (vla-get-Center obj))
)
StartPoint (vlax-safearray->list
(vlax-variant-value (vla-get-StartPoint obj))
)
MajorRadius (vla-get-MajorRadius obj)
MinorRadius (vla-get-MinorRadius obj)
)
(setq ang1 (angle center-point startpoint)
ang2 (+ ang1 (* pi 0.5))
)
(setq point10 (polar center-point ang1 (+ MajorRadius 300))
point11 (polar center-point
(+ ang1 pi)
(+ MajorRadius 300)
)
point20 (polar center-point ang2 (+ MinorRadius 300))
point21 (polar center-point
(+ ang2 pi)
(+ MinorRadius 300)
)
)
(command "LINE" point10 point11 "")
(command "LINE" point20 point21 "")
)
;; 所选物体是矩形
((= name "LWPOLYLINE")
(setq obj (vlax-Ename->Vla-Object ent0))
(setq point (vlax-safearray->list
(vlax-variant-value (vla-get-Coordinates obj))
)
)
(if (= (length point) 8)
(progn
(setq p1 (list (nth 0 point) (nth 1 point))
p2 (list (nth 2 point) (nth 3 point))
p3 (list (nth 4 point) (nth 5 point))
p4 (list (nth 6 point) (nth 7 point))
)
(setq center-point (mapcar '(lambda (a b) (/ (+ a b) 2))
p1
p3
)
ang1 (angle p1 p2)
ang2 (angle p1 p4)
d1 (distance p1 p2)
d2 (distance p1 p4)
)
(setq point10 (polar center-point ang1 (+ (* d1 0.5) 300))
point11 (polar center-point
(+ ang1 pi)
(+ (* d1 0.5) 300)
)
point20 (polar center-point ang2 (+ (* d2 0.5) 300))
point21 (polar center-point
(+ ang2 pi)
(+ (* d2 0.5) 300)
)
)
(command "LINE" point10 point11 "")
(command "LINE" point20 point21 "")
)
(princ "\n所选物体不是矩形,请重新选择!")
)
)
)
)
(defun c:zx ()
(vl-load-com)
(princ "\n 请选择直线、圆、圆弧、椭圆和矩形:")
(setq ss (ssget '((0 . "LINE,CIRCLE,ARC,ELLIPSE,LWPOLYLINE")))
i0
)
(while (setq ent0 (ssname ss i))
(zx_1)
(setq i (1+ i))
)
(setvar "OSMODE" os)
(setvar "cmdecho" cmd)
(princ)
)
对直线结果不对，没关系。只是那多选画了那矩形的那交叉线后那捕捉没了。还有就那U不能一下U完。小问题没关系了。 本帖最后由 xq4u 于 2011-7-16 08:32 编辑
Andyhon 发表于 2011-7-15 12:38 http://bbs.mjtd.com/static/image/common/back.gif
开始没注意到，原来运行命令是：zx，很好用，可以框选。
页:
[1]