请教grread函数的应用
本帖最后由 x_s_s_1 于 2011-3-1 11:36 编辑搞不清这个自定义函数哪里错了，主要是grread函数搞不懂，看帮助也看不懂，请大家帮看看下面的函数如何修改
（信。cad提醒是得到点的组码位置错了）但我不知如何修改
;;;拖曳子函数pt需改变点，en需改变数据列表，
(defun drag (pt en /)
(while (/= (car (setq mouse (grread mouse 5 1))) 3)
;点击左键退出循环，即退出拖拽状态
(setq ptg (cadr mouse)) ;mouse为鼠标坐标值
(setq dist (distance pt ptg));点到鼠标距离
(setq ang (angle pt ptg)) ;点到鼠标角度
(setq newpt (polar pt ang dist));新点坐标
(setq zm (car (assoc pt en)));得到点的组码
(setq en (subst (cons zm newpt) (assoc zm en) en)) ;更新点坐标
(entmod en) ;更新定义数据
) ;endwhile拖曳
) ;_ 结束defun
(while (/= (car (setq mouse (grread mouse 5 1))) 3)
改成
(while (/= (car (setq mouse (grread T 4 0))) 3)
试试 回复 x_s_s_1 的帖子
;;;拖曳子函数pt需改变点，en需改变数据列表，
;(drag (getpoint) (entget (car(entsel "\n选择物体:"))))
(defun drag (pt en / ptg mouse newen)
(while (/= (car (setq mouse (grread mouse 5 1))) 3)
;点击左键退出循环，即退出拖拽状态
(setq ptg (cadr mouse)) ;mouse为鼠标坐标值
;(setq dist (distance pt ptg));点到鼠标距离
;(setq ang (angle pt ptg)) ;点到鼠标角度
;(setq newpt (polar pt ang dist));新点坐标 以上三行代码没用，newpt = ptg
;(setq zm (car (assoc pt en)));得到点的组码 ，该行语法错误，返回nil
;(setq en (subst (cons zm newpt) (assoc zm en) en)) ;更新点坐标
;;;若要判断是修改某个点，可根据pt逐个比较en里坐标，然后更新，
(setq newen nil)
(foreach a en
(if (equal (cdr a) pt 1e-6)
(setq newen (append newen (list (cons (car a) ptg))))
(setq newen (append newen (list a)))
)
)
(entmod newen) ;更新定义数据
) ;endwhile拖曳
) ;_ 结束defun
本帖最后由 x_s_s_1 于 2011-3-1 14:26 编辑
谢谢两位版主，下面是我自己改的蠢办法，呵呵;;;拖曳子函数ptz需改变点组码，en需改变数据列表，
(defun drag (ptz en /)
(while (/= (car (setq mouse (grread mouse 5 1))) 3)
;点击左键退出循环，即退出拖拽状态
(setq ptg (cadr mouse)) ;mouse为鼠标坐标值
(setq dist (distance (cdr ptz) ptg));点到鼠标距离
(setq ang (angle (cdr ptz) ptg)) ;点到鼠标角度
(setq newpt (polar (cdr ptz) ang dist));新点坐标
(setq zm (car ptz));得到点的组码
(setq en (subst (cons zm newpt) (assoc zm en) en)) ;更新点坐标
(entmod en) ;更新定义数据
) ;endwhile拖曳
) ;_ 结束defun
本帖最后由 x_s_s_1 于 2011-3-1 18:19 编辑
这个程序初衷是想动态拖动多重引线，但是由于不会一次更新多个图元，导致程序效果达不到自己的想法，看哪位大侠可以帮看看，指点一下
(defun c:mytest ()
(setvar "OSMODE" 0)
(setq ss1 (ssget '((0 . "text")))) ;获取标注内容选择集SS1
(setq sn1 (ssname ss1 0));获取标注内容图元名Sn1
(setq en1 (entget sn1)) ;获取标注内容定义数据列表en1
(setq pt1 (cdr (assoc 11 en1)));获取标注内容插入点pt1
(setq ang1 (cdr (assoc 50 en1))) ;获取标注内容角度ang1
(setq pt2 (polar pt1 (- ang1 (/ pi 2)) 100)) ;引线上点pt2
(setq ss2 (ssget pt2)) ;获取引线选择集SS2
(setq sn2 (ssname ss2 0));获取引线图元名Sn2
(setq en2 (entget sn2)) ;获取引线定义数据列表en2
(setq pt3 (cdr (assoc 10 en2)));获取引线点1--pt3
(setq pt4 (cdr (assoc 11 en2)));获取引线点2--pt4
(setq ss3 (ssget "f" (list pt3 pt4) '((0 . "circle"))))
;获取编号圈选择集SS3
(setq sn3 (ssname ss3 0));获取编号圈图元名Sn3
(setq en3 (entget sn3)) ;获取编号圈定义数据列表en3
(setq ss4 (ssget "f" (list pt3 pt4) '((0 . "line"))))
;获取引出线及引线选择集SS4
(setq ss5 (ssget "_cp" (objectpoint en3) '((0 . "TEXT"))))
;获取编号选择集SS5
(setq lists (list en1 en3))
(setq lists (list en1 en3 (entget (ssname ss5 0))))
(setq i 0)
(setq number (sslength ss4))
(while (< i number)
(progn
(setq lists (cons (entget (ssname ss4 i)) lists))
(setq i (1+ i))
) ;endprogn
) ;endwhile形成定义数据列表的表
(setq number (+ 3 number))
(setq i 0)
(while (< i number)
(progn
(setq en (nth i lists))
(if (wcmatch (cdr (assoc 0 en)) "LINE")
(progn
(setq zmn 10)
(while (< zmn 12)
(setq ptz (assoc zmn en))
(p_in_l (cdr ptz) pt3 pt4)
(setq zmn (1+ zmn))
(drag ptz en)
) ;endwhile
) ;endprogn
(if (wcmatch (cdr (assoc 0 en)) "TEXT")
(progn
(setq ptz (assoc 11 en))
(drag ptz en)
) ;endprogn
(if (wcmatch (cdr (assoc 0 en)) "CIRCLE")
(progn
(setq ptz (assoc 10 en))
(drag ptz en)
) ;endprogn
) ;endif_circle
) ;endif_text
) ;endif_line
) ;endprogn
(setq i (1+ i))
) ;endwhile循环拖曳
) ;_ 结束defun
;;; -----------------------------------------------------------------;
;;;拖曳子函数ptz需改变点组码，en需改变数据列表
(defun drag (ptz en / mouse ptg dist ang newpt zm)
(while (/= (car (setq mouse (grread mouse 5))) 3)
;点击左键退出循环，即退出拖拽状态
(setq ptg (cadr mouse));mouse为鼠标坐标值
(setq dist (distance (cdr ptz) ptg)) ;点到鼠标距离
(setq ang (angle (cdr ptz) ptg)) ;点到鼠标角度
(setq newpt (polar (cdr ptz) ang dist)) ;新点坐标
(setq zm (car ptz)) ;得到点的组码
(setq en (subst (cons zm newpt) (assoc zm en) en)) ;更新点坐标
(entmod en) ;更新定义数据
) ;endwhile返回新坐标
) ;_ 结束defun
;;; -----------------------------------------------------------------;
;;;判断点在线上，在返回该点，不在返回nil
(defun p_in_l (pt pt1 pt2 /)
(if (= (+ (distance pt pt1) (distance pt pt2))
(distance pt1 pt2)
) ;_ 结束=
pt
nil
) ;_ 结束if
) ;_ 结束defun
;;; -----------------------------------------------------------------;
;;; the subrountine is write by qjchen to get selection by circle
;;; and lwpolyline
(defun objectpoint (obj / name ori i r w_pl_lst wlist)
(setq name (cdr (assoc 0 obj)))
(cond
((= name "CIRCLE")
(setq ori (cdr (assoc 10 obj)))
(setq r (cdr (assoc 40 obj)))
(setq i 0)
(repeat 30
(setq wlist (append
wlist
(list (polar ori (* 2 pi (/ i 30.0)) r))
) ;_ 结束append
) ;_ 结束setq
(setq i (1+ i))
) ;_ 结束repeat
)
((= name "LWPOLYLINE")
(defun w_pl_lst (ent / pt_list)
(foreach x ent
(if (= (car x) 10)
(setq pt_list (append
(list (cdr x))
pt_list
) ;_ 结束append
) ;_ 结束setq
) ;_ 结束if
) ;_ 结束foreach
pt_list
) ;_ 结束defun
(setq wlist (w_pl_lst obj))
)
) ;_ 结束cond
wlist
) ;_ 结束defun
这个程序的操作对象是什么？ 本帖最后由 x_s_s_1 于 2011-3-2 14:44 编辑
字、线、圆组成的多重引线，信.cad提供的思路选择 文字→查找文字下方的 横线 再查找与横线相交的 圆 和直线 通过圆来定位序号 再用 grread来定位鼠标位置调整，;;;感谢 信●cad，程序思路为其提供，并且给予编程上的指导
;;;感谢bbs.mjtd.com版主ZZXXQQ及版主Gu_xl的指导
;;;测序为自用，未考虑容错处理
;;;2011.03.02剩余未解决问题：未去除与引线相交但端部不在引线上的引出线
;;; -----------------------------------------------------------------;
;;;获取定义数据列表en，ss选择集，i序号
(defun xx_en (ss i / en)
(setq en (entget (ssname ss i)))
) ;end_defun
;;; -----------------------------------------------------------------;
;;;获取坐标pt，或角度,en定义数据列表,g_c组码
(defun xx_pt (g_c en / pt)
(setq pt (cdr (assoc g_c en)))
) ;end_defun
;;; -----------------------------------------------------------------;
;;;判断点在线上，在返回该点，不在返回nil
(defun p_in_l (pt pt1 pt2 /)
(if (= (+ (distance pt pt1) (distance pt pt2))
(distance pt1 pt2)
) ;_ 结束=
pt
nil
) ;_ 结束if
) ;_ 结束defun
;;; -----------------------------------------------------------------;
;;; 选择圆内文字
(defun objectpoint (obj / name ori i r w_pl_lst wlist)
(setq name (cdr (assoc 0 obj)))
(cond
((= name "CIRCLE")
(setq ori (cdr (assoc 10 obj)))
(setq r (cdr (assoc 40 obj)))
(setq i 0)
(repeat 30
(setq wlist (append
wlist
(list (polar ori (* 2 pi (/ i 30.0)) r))
) ;_ 结束append
) ;_ 结束setq
(setq i (1+ i))
) ;_ 结束repeat
)
((= name "LWPOLYLINE")
(defun w_pl_lst (ent / pt_list)
(foreachx ent
(if (= (car x) 10)
(setq pt_list (append
(list (cdr x))
pt_list
) ;_ 结束append
) ;_ 结束setq
) ;_ 结束if
) ;_ 结束foreach
pt_list
) ;_ 结束defun
(setq wlist (w_pl_lst obj))
)
) ;_ 结束cond
wlist
) ;_ 结束defun
;;; -----------------------------------------------------------------;
;;;主程序命令ty
(defun c:ty ()
(setvar "OSMODE" 0)
(setq ss1 (ssget '((0 . "text"))));获取标注内容选择集SS1
(setq en1 (xx_en ss1 0)) ;获取标注内容定义数据列表en1
(setq pt1 (xx_pt 11 en1)) ;获取标注内容插入点pt1
(setq ang1 (xx_pt 50 en1)) ;获取标注内容角度ang1
(setq pt2 (polar pt1 (- ang1 (/ pi 2)) 100)) ;引线上点pt2
(setq ss2 (ssget pt2)) ;获取引线选择集SS2
(setq en2 (xx_en ss2 0)) ;获取引线定义数据列表en2
(setq pt3 (xx_pt 10 en2)) ;获取引线点1--pt3
(setq pt4 (xx_pt 11 en2)) ;获取引线点2--pt4
(setq ss3 (ssget "f" (list pt3 pt4) '((0 . "circle"))))
;获取编号圈选择集SS3
(setq en3 (xx_en ss3 0)) ;获取编号圈定义数据列表en3
(setq ss4 (ssget "_cp" (objectpoint en3) '((0 . "TEXT"))))
;获取编号选择集SS4
(setq en4 (xx_en ss4 0))
(setqss5 (ssdel (ssname ss2 0)
(ssget "f" (list pt3 pt4) '((0 . "line")))
) ;_ 结束ssdel
) ;获取引出线选择集SS5
(setq number (sslength ss5))
(setq lists (mapcar 'entget (mapcar 'cadr (ssnamex ss5))))
(while (/= (car (setq mouse (grread T 5 0))) 3)
(setq ptg (cadr mouse))
(setq ang (angle pt1 ptg))
(setq dist (distance pt1 ptg))
(setq newpt (polar pt1 ang dist))
(setq en1 (subst (cons 11 newpt) (assoc 11 en1) en1)) ;更新点坐标
(entmod en1)
(setq newpt (polar pt3 ang dist))
(setq en2 (subst (cons 10 newpt) (assoc 10 en2) en2)) ;更新点坐标
(entmod en2)
(setq newpt (polar pt4 ang dist))
(setq en2 (subst (cons 11 newpt) (assoc 11 en2) en2)) ;更新点坐标
(entmod en2)
(setq newpt (polar (xx_pt 10 en3) ang dist))
(setq en3a (subst (cons 10 newpt) (assoc 10 en3) en3)) ;更新点坐标
(entmod en3a)
(setq newpt (polar (xx_pt 11 en4) ang dist))
(setq en4a (subst (cons 11 newpt) (assoc 11 en4) en4)) ;更新点坐标
(entmod en4a)
;;;(mapcar '(lambda (x) (assoc 11 x)) lists)
(setq i 0)
(while (< i number)
(setq en (nth i lists))
(setq zmn 10)
(while (< zmn 12)
(setq ptz (assoc zmn en))
(p_in_l (cdr ptz) pt3 pt4)
(setq zmn (1+ zmn))
) ;endwhile本句返回PTZ及en
(setq newpt (polar (cdr ptz) ang dist))
(setq
ennew (subst (cons (car ptz) newpt) (assoc (car ptz) en) en)
) ;_ 结束setq
(entmod ennew)
(setq i (1+ i))
) ;endwhile
) ;endwhile结束拖曳
) ;_ 结束defun
学习一下，好东东呀
页:
[1]