如果在执行程序（挪圆）前，将直线Z坐标归0？
(defun c:ny(/ center circle index lineobj point point_01 point_02 pointlist sscircle ssline syh temp varvalue)(vl-load-com)
(setvar "cmdecho" 0)
(princ "\n请选取要处理的直线对象")
(setq ssLine (ssget '((0 . "LINE"))))
(if (/= ssLine nil)
(progn (setq syh 0)
(vl-cmdf ".zoom" "e")
(repeat (sslength ssLine)
(setq LineObj (vlax-ename->vla-object (ssname ssLine syh)))
(setq Point_01 (vlax-get LineObj 'StartPoint))
(setq Point_02 (vlax-get LineObj 'EndPoint))
(setq ssCircle (ssget "f" (list Point_01 Point_02) '((0 . "CIRCLE"))))
(if (/= ssCircle nil)
(progn (setq index 0)
(repeat (sslength ssCircle)
(setq Circle (vlax-ename->vla-object (ssname ssCircle index)))
(setq Center (vlax-get Circle 'Center))
(setq VarValue (vlax-variant-value (vlax-invoke-method LineObj 'IntersectWith Circle acExtendNone)))
(setq PointList (vl-catch-all-apply 'vlax-safearray->list (list VarValue)))
(if (not (vl-catch-all-error-p PointList))
(cond ((= (length PointList) 3)
(if (< (distance Center Point_01)(distance Center Point_02))
(vl-catch-all-apply 'vlax-put (list Circle 'Center Point_01))
(vl-catch-all-apply 'vlax-put (list Circle 'Center Point_02))
)
)
((= (length PointList) 6)
(progn (setq Point (list (* (+ (nth 0 PointList)(nth 3 PointList)) 0.5)(* (+ (nth 1 PointList)(nth 4 PointList)) 0.5) (caddr Center)))
(vl-catch-all-apply 'vlax-put (list Circle 'Center Point))
)
)
)
)
(setq index (+ index 1))
)
)
)
(setq syh (+ syh 1))
)
(vl-cmdf ".zoom" "p")
(alert "完成！")
)
)
(princ)
)
这是原程序，如何在执行前将直线的Z坐标归0？谁能修改一下添加此功能，谢谢！！
本帖最后由 llsheng_73 于 2013-12-20 22:45 编辑
(defun c:ny(/ center circle index lineobj point point_01 point_02 radius ssline syh)
(vl-load-com)
(setvar "cmdecho" 0)
(princ "\n请选取要处理的直线对象")
(if(setq ssLine (ssget '((0 . "LINE"))))
(progn (setq syh 0)
(vl-cmdf ".zoom" "e")
(repeat (sslength ssLine)
(entmod(setq LineObj(ssname ssLine syh)syh(1+ syh)
point(entget LineObj)
LineObj(vlax-ename->vla-object LineObj)
Point_01(cdr(assoc 10 point))
Point_01(list(car Point_01)(cadr Point_01)0)
Point_02(cdr(assoc 11 point))
Point_02(list(car Point_02)(cadr Point_02)0)
point(subst(cons 10 Point_01)(assoc 10 point)point)
point(subst(cons 11 Point_02)(assoc 11 point)point)))
(if(setq ssCircle(ssget"F"(list Point_01 Point_02)'((0 . "CIRCLE"))))
(progn (setq index 0)
(repeat (sslength ssCircle)
(entmod(setq Circle (entget(ssname ssCircle index))index(1+ index)
radius(cdr(assoc 40 Circle))
Center(vlax-curve-getClosestPointTo LineObj (cdr(assoc 10 Circle)) t)
center(if(<(distance Point_01 Center)radius)Point_01
(if(<(distance Point_02 Center)radius)Point_02 Center))
circle(subst(cons 10 Center)(assoc 10 Circle)Circle)))))))
(vl-cmdf ".zoom" "p")
(alert "完成！")
))
(princ)
)
(defun c:tt ()
(defun dxf (code s1) (cdr (assoc code (entget s1))))
(defun 3d2d (pt) (mapcar '+ '(0 0) pt))
(princ "\n请选取要处理的直线对象: ")
(setq i -1)
(if (setq ss (ssget '((0 . "line"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq p1 (dxf 10 s1)
p2 (dxf 11 s1)
rad (angle p1 p2)
j -1
)
(if (setq ss1 (ssget "f" (list p1 p2) '((0 . "circle"))))
(while (setq s2 (ssname ss1 (setq j (1+ j))))
(setq p0(dxf 10 s2)
p01 (3d2d p0)
p02 (polar p01 (+ rad (* pi 0.5)) 1)
pt(inters (3d2d p1) (3d2d p2) p01 p02 nil)
pt(list (car pt) (cadr pt) (caddr p0))
)
(command "move" s2 "" "non" p0 "non" pt)
)
)
)
)
(princ)
) 本帖最后由 xyp1964 于 2013-12-20 12:34 编辑
(defun c:tt ()
(defun dxf (code s1) (cdr (assoc code (entget s1))))
(defun 3d2d (pt) (mapcar '+ '(0 0) pt))
(defun move (s1 p1 p2)
(command "move" s1 "" "non" p1 "non" p2)
)
(princ "\n请选取要处理的直线对象: ")
(setq i -1)
(if (setq ss (ssget '((0 . "line"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(setq p1 (dxf 10 s1)
p2 (dxf 11 s1)
p1a (3d2d p1)
p2a (3d2d p2)
rad (angle p1 p2)
j -1
)
(move s1 p1 p1a)
(if (setq ss1 (ssget "f" (list p1 p2) '((0 . "circle"))))
(while (setq s2 (ssname ss1 (setq j (1+ j))))
(setq p0(dxf 10 s2)
p01 (3d2d p0)
p02 (polar p01 (+ rad (* pi 0.5)) 1)
pt(inters p1a p2a p01 p02 nil)
;;pt(list (car pt) (cadr pt) (caddr p0))
rr(dxf 40 s2)
p3(cond ((<= (distance p01 p1a) rr) p1a)
((<= (distance p01 p2a) rr) p2a)
(t pt)
)
)
(move s2 p0 p3)
)
)
)
)
(princ)
)
xyp1964 发表于 2013-12-19 22:29 static/image/common/back.gif
有两个问题：
1.直线Z坐标仍然没归零。
2.圆内有端点必须把圆心挪在端点上，园内没端点的才挪在直线上（这个已解决） ;;;************************Z坐标归0
(defun h-gc1 (/ SS)
(command "._ucs" "_W") ;世界坐标系
(setq ss (ssget))
;;Z坐标归零,主要是地形线的影响，所以这一个很重要
(if ss
(vl-cmdf ".MOVE" ss "" "0,0,0"
"0,0,1000e99" ".MOVE" "P"
"" "0,0,1000e99" "0,0,0"
)
)
(princ)
)
;;;************************Z坐标归0;;;************************Z坐标归 xyp1964 发表于 2013-12-19 22:29 static/image/common/back.gif
麻烦高手再改进一下，达到效果如图,第一种才是想要的 xyp1964 发表于 2013-12-19 22:29 static/image/common/back.gif
果然好用！！谢谢了
页:
[1]