点击生成垂直相交线
生成十字相交线条件:
1--四边方向均有线的 不管封闭的还是未封闭的..
2--只要在四边方向都有线的,内侧任意点击就生成,两条垂直相交的线
3--垂直相交的线,取任意一边线中点与对应的另一边线垂直就好
4--十字相交的线和绝对是90度的
5--只要处理形似矩形的就好
6--一个一个就击生成
7--生成的相交线是新建一个层的
附图如下
测试文件
本帖最后由 Gu_xl 于 2011-12-15 16:44 编辑
给你来个动态的
;;;右键结束命令
(defun c:tt(/ GR PT VS P1 P2 P3 P4 LINE1 LINE2 flag)
(while (not flag)
;(/= (car (setq gr (grread t 5 2))) 3)
(setq gr (grread t 7 2))
(cond ((= 5 (car gr))
(setq pt (cadr gr))
(setq vs (gxl-Sys-GetViewSize))
(if line1 (entdel line1))
(if line2 (entdel line2))
(setq line1 nil line2 nil)
(if (and
(setq p1 (getNearPoint pt (list (caadr vs) (cadr pt) (caddr pt)))) ;_ 向右
(setq p2 (getNearPoint pt (list (caar vs) (cadr pt) (caddr pt)))) ;_ 向左
(setq p3 (getNearPoint pt (list (car pt) (cadadr vs) (caddr pt)))) ;_ 向上
(setq p4 (getNearPoint pt (list (car pt) (cadar vs) (caddr pt)))) ;_ 向下
)
(progn
(setq line1 (makeline p1 p2))
(setq line2 (makeline p3 p4))
)
)
)
((= 25 (car gr))
(setq flag t)
(if line1 (entdel line1))
(if line2 (entdel line2))
(setq line1 nil line2 nil)
)
((= 3 (car gr))
(setq line1 nil line2 nil)
)
)
)
)
;;;用到的函数
;(gxl-Sys-GetViewSize)
(defun gxl-Sys-GetViewSize (/ pc vh sc vw vh pmin pmax)
(setq pc (getvar "viewctr")
vh (getvar "viewsize")
sc (getvar "screensize")
vw (* vh (/ (car sc) (cadr sc)))
pmin (list (- (car pc) (* 0.5 vw)) (- (cadr pc) (* 0.5 vh)))
pmax (list (+ (car pc) (* 0.5 vw)) (+ (cadr pc) (* 0.5 vh)))
)
(list pmin pmax)
)
(defun makeline (p1 p2)
(entmake (list (cons 0 "line")
(cons 8 "十字交叉") ;_ 图层
(cons 62 1) ;_ 颜色
(cons 10 (trans p1 1 0))
(cons 11 (trans p2 1 0))
)
)
(entlast)
)
;;;(gxl-SortPointOnCurvepoints curve) 参数 点集 points 曲线图元 curve 点集沿曲线排序
(defun gxl-SortPointOnCurve (points curve / pl1 xx nn)
(setq pl1 (mapcar '(lambda (xx /)
(vlax-curve-getparamatpoint
curve
(vlax-curve-getclosestpointto curve xx)
)
)
points
)
)
(mapcar '(lambda (nn) (nth nn points))
(vl-sort-i pl1 '<)
)
)
(defun gxl-lst-split (lst len / tmp)
(if lst
(cons
(reverse
(repeat len
(if (car lst)
(setq tmp (cons (car lst) tmp)
lst (cdr lst)
)
)
tmp ;_ 制造返回值
)
)
(gxl-lst-split lst len)
)
)
)
(defun gxl-GetInterPointlist (obj1 obj2 )
(if (= 'ENAME (type obj1))
(setq obj1 (vlax-ename->vla-object obj1))
(if (= 'STR (type obj1))
(setq obj1 (vlax-ename->vla-object (handent obj1)))
)
)
(if (= 'ENAME (type obj2))
(setq obj2 (vlax-ename->vla-object obj2))
(if (= 'STR (type obj2))
(setq obj2 (vlax-ename->vla-object (handent obj2)))
)
)
(gxl-SortPointOnCurve (gxl-lst-split (vlax-invoke obj2 'IntersectWith obj1 acExtendNone) 3) obj2)
)
;;;计算与p1最近交点,没有返回nil
(defun getNearPoint (P1 P2 / SS LINE N EN PTS PT dxf)
(setq ss (ssget "f" (list p1 p2)))
(if ss
(progn
(setq line (makeline p1 p2))
(repeat (setq n (sslength ss))
(setq en (ssname ss (setq n (1- n))))
(if (or
(wcmatch (setq dxf (cdr (assoc 0 (entget en)))) "*LINE")
(= dxf "ARC")
(= dxf "CIRCLE")
(= dxf "ELLIPSE")
)
(setq pts (append pts (gxl-GetInterPointlist line en)))
)
)
(if pts
(setq pt (trans (car (gxl-SortPointOnCurve pts line)) 0 1))
)
(entdel line)
)
)
pt
)
去下载我的角平分线吧 示例中的十字线有对中与不对中的差异
取决于什么条件? Andyhon 发表于 2011-12-15 12:47 static/image/common/back.gif
示例中的十字线有对中与不对中的差异
取决于什么条件?
这个没有。。只要是十字线一边是从中点开始的。对应下来是垂直就好 呵呵，羡慕有钱人哦。
Qjchen的有个程序可能适合你这样的情况。
我要适用的适合的我弄不了啊 ;;; 未经严谨测试
(Defun C:Test ()
(setq oldLs (getvar 'LtScale))
(setvar 'OsMode 0)
(setq xx (list 1 0 0)
yy (list 0 1 0)
)
(command "LtScale" 1)
(While (Setq Pt (getpoint "\n内侧任意点击就生成,两条垂直相交的线: "))
(setq p2 (mapcar '+ pt xx))
(entmake (list '(0 . "LINE") (cons 10 pt) (cons 11 p2)))
(setq ee (entlast))
(command "Extend" "All" "" pt p2 "")
(setq pts (acet-geom-object-end-points ee)
p5 (apply 'acet-geom-midpoint pts)
pa (car pts)
)
(entdel ee)
(setq Pt5 (apply 'acet-geom-midpoint (acet-geom-object-end-points (ssname (ssget pa '((0 . "LINE"))) 0)))
p2 (mapcar '+ p5 yy)
)
(entmake (list '(0 . "LINE") (cons 10 p5) (cons 11 p2)))
(command "Extend" "All" "" p5 p2 "")
(entdel ee)
(command "move" ee "" pa pt5)
)
(setvar 'LtScale oldLs)
) Gu_xl 谢谢您很强大。佩服太开心了 向Gu_xl 哥至敬
页:
[1]
2