高手请进，急急急.............

zhongys

我要在两条线的中心画一中心线，程式选择两条线后自动画出中心线，但选择的只能为线，如果选择的不是线或选择的是空集则重新选择，下面的程式在判段的时候不对，望各位多多指教 (DEFUN C:2CL()
(setvar "cmdecho" 0)
(setq old_la (getvar "clayer"))
(setq en1 (entsel "\n请选择第一条线: "))
(while (= en1 nil) (setq en1 (entsel "\n请选择第一条线: ")))
(setq %na (cdr (assoc 0 (entget (car en1)))))
(while (/= %na "LINE") (setq en1 (entsel "\n请选择第一条线: "))) ;;;;;出错
(setq ps1 (cdr(assoc 10 (entget (car en1)))))
(setq pe1 (cdr(assoc 11 (entget (car en1)))))
(setq psx1 (car ps1))
(setq psy1 (cadr ps1))
(setq pex1 (car pe1))
(setq pey1 (cadr pe1))
(setq px1 (* 0.5 (+ psx1 pex1)))
(setq py1 (* 0.5 (+ psy1 pey1)))
(setq p1 (list px1 py1))
(setq en2 (entsel "\n请选择第二条线: "))
(while (= en2 nil) (setq en2 (entsel "\n请选择第二条线: ")))
(setq %na (cdr (assoc 0 (entget (car en2)))))
(while (/= %na "LINE") (setq en2 (entsel "\n请选择第二条线: "))) ;;;;;出错
(setq ps2 (cdr(assoc 10 (entget (car en2)))))
(setq pe2 (cdr(assoc 11 (entget (car en2)))))
(setq psx2 (car ps2))
(setq psy2 (cadr ps2))
(setq pex2 (car pe2))
(setq pey2 (cadr pe2))
(setq px2 (* 0.5 (+ psx2 pex2)))
(setq py2 (* 0.5 (+ psy2 pey2)))
(setq p2 (list px2 py2))
(setq %in (inters ps1 pe1 ps2 pe2 nil))
(setq ang1 (angle %in p1))
(setq ang2 (angle %in p2))
(setq di1 (* 2 (distance %in p1)))
(setq di2 (* 2 (distance %in p2)))
(setq p3 (polar p1 ang2 di2))
(setq p4 (polar p2 ang1 di1))
(setq cen_la (tblsearch "layer" "中心线层"))
(if (= cen_la NIL)
(command "layer" "M" "中心线层" "c" "1" "中心线层" "lt" "center" "中心线层" "")
)
(setvar "clayer" "中心线层")
(command "line" p1 p3 "")
(command "line" p2 p4 "")
(setvar "clayer" old_la)
(princ)
)

zhongys

注意;如果你的两条线是平行的则画不出来,

yxp

好罗嗦的程序。是不是这种效果。

BDYCAD

我的是繁體系統所以會把一些簡體字變成 ??? 號, 真不好意思, 如选到的是两条平衡线你怎么办? (DEFUN C:2CL()
(setvar "cmdecho" 0)
(setq old_la (getvar "clayer"))
(setq en1 NIL BD "BB")
(while (/= BD "LINE")
(setq en1 (CAR(entsel "\n???第一??: ")))
(WHILE (= en1 NIL)(setq en1 (CAR(entsel "\n???第一??: "))))
(SETQ BD (cdr (assoc 0 (entget en1))))
)
(setq ps1 (vlax-curve-getstartpoint en1))
(setq pe1 (vlax-curve-getendpoint en1))
(setq p1 (POLAR ps1 (ANGLE ps1 pe1) (* 0.5 (DISTANCE ps1 pe1))))
(setq en2 NIL BD "BB")
(while (/= BD "LINE")
(setq en2 (CAR (entsel "\n???第一??: ")))
(WHILE (= en2 NIL)(setq en2 (CAR(entsel "\n???第一??: "))))
(SETQ BD (cdr (assoc 0 (entget en2))))
)
(setq ps2 (vlax-curve-getstartpoint en2))
(setq pe2 (vlax-curve-getendpoint en2))
(setq p2 (POLAR ps2 (ANGLE ps2 pe2) (* 0.5 (DISTANCE ps2 pe2))))
(setq %in (inters ps1 pe1 ps2 pe2 nil))
(IF %in
(PROGN
(setq ang1 (angle %in p1))
(setq ang2 (angle %in p2))
(setq di1 (* 2 (distance %in p1)))
(setq di2 (* 2 (distance %in p2)))
(setq p3 (polar p1 ang2 di2))
(setq p4 (polar p2 ang1 di1))
(setq cen_la (tblsearch "layer" "中心??"))
(if (= cen_la NIL)
(command "layer" "M" "中心??" "c" "1" "中心??" "lt" "center" "中心??" "")
)
(setvar "clayer" "中心??")
(command "line" p1 p3 "")
(command "line" p2 p4 "")
(setvar "clayer" old_la)))
(princ)
)

zhongys

e:aa.bmp

zhongys

谢谢BDYCAD，如果两条线是平行线的修改后会传上来。