liminnet
发表于 2008-5-29 17:38:00
ayunger
发表于 2008-6-1 16:35:00
本帖最后由 作者 于 2008-6-1 16:37:45 编辑 <br /><br /> <p>;;;*****************************************<br/>;;; By AyungerStudio 2008.06.01 <br/>;;; <br/>;;; 拾取参考点坐标('MM为透明方式) 函数 <br/>;;;*****************************************<br/>(defun C:MM (/ iCross iArw xType Pt1 Pt2 Pt3 oldOsnap EntPick1 Ang1 EntPick2 Ang2)<br/> (setq oldOsnap (getvar "osmode"))<br/> (if (= #AY_PICKMODETYPE nil) (setq #AY_PICKMODETYPE "Q"))<br/> (setq iCross 10.0);像素值.<br/> (setq iArw 50.0);像素值.<br/> (initget "Q Z")<br/> (setq xType (getkword (strcat "\n交点模式 正交(Z)/切线(Q)<" #AY_PICKMODETYPE">: ")))<br/> (if (= xType nil) (setq xtype #AY_PICKMODETYPE) (setq #AY_PICKMODETYPE xtype))<br/> (if (= xType "Z")<br/> (progn;then for xType="Z"<br/> (setq Pt1 (getpoint "\n指定X参考轴点: "))<br/> (ayGRCross Pt1 iCross 222 T)<br/> (ayGRArw Pt1 0.0 iArw (* iArw 0.325) 222 T)<br/> <br/> (setq Pt2 (getpoint "\n指定Y参考轴点: "))<br/> (ayGRCross Pt2 iCross 72 T)<br/> (ayGRArw Pt2 (* pi 0.5) iArw (* iArw 0.325) 72 T)<br/> <br/> (setq Pt3 (list (car Pt2) (cadr Pt1) 0.0))<br/> (ayGRCross Pt3 iCross 1 T)<br/> (ayGRCross Pt3 iCross 1 nil)<br/> );end_progn then<br/> <br/> (progn;then for xType="Q"<br/> (setvar "osmode" 512);Neareast osmode<br/> (while (not (setq EntPick1 (entsel "\n选择参考轴对象1: "))))<br/> (setq Pt1 (ayGetPerPoint (car EntPick1) (cadr EntPick1)))<br/> (setq Ang1 (ayGetTanAngle (car EntPick1) (cadr EntPick1)))<br/> (ayGRCross Pt1 iCross 222 T)<br/> (ayGRArw Pt1 Ang1 iArw (* iArw 0.325) 222 T)<br/> <br/> (while (not (setq EntPick2 (entsel "\n选择参考轴对象2: "))))<br/> (setq Pt2 (ayGetPerPoint (car EntPick2) (cadr EntPick2)))<br/> (setq Ang2 (ayGetTanAngle (car EntPick2) (cadr EntPick2)))<br/> (ayGRCross Pt2 iCross 72 T)<br/> (ayGRArw Pt2 Ang2 iArw (* iArw 0.325) 72 T)</p><p> (setq Pt3 (inters Pt1 (polar Pt1 Ang1 1.0) Pt2 (polar Pt2 Ang2 1.0) nil))<br/> (if Pt3<br/> (progn<br/> (ayGRCross Pt3 iCross 1 T)<br/> (ayGRCross Pt3 iCross 1 nil)<br/> );end_progn<br/> (princ "\n错误: 两切线无交点(平行)!")<br/> );end_if<br/> (setvar "osmode" oldOsnap)<br/> );end_progn else<br/> );end_if<br/> (princ)<br/> (setq Pt3 Pt3)<br/>);end_defun</p><p>;;;***************************<br/>;;; 绘制屏幕十字丝 函数 <br/>;;;***************************<br/>(defun ayGRCross (xPoint xCrossLen iColor xMode / iCross aUnit Pt1 Pt2 Pt3 Pt4)<br/> (setq aUnit (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))<br/> (setq iCross (* xCrossLen aUnit 0.5))<br/> (setq Pt1 (polar xPoint 0.0 iCross))<br/> (setq Pt2 (polar xPoint PI iCross))<br/> (setq Pt3 (polar xPoint (* PI 0.5) iCross))<br/> (setq Pt4 (polar xPoint (* PI 1.5) iCross))<br/> (grdraw (polar xPoint 0.0 iCross) (polar xPoint PI iCross) iColor)<br/> (grdraw Pt1 Pt2 iColor (if xMode 1 0))<br/> (grdraw Pt3 Pt4 (rem (+ 10 iColor) 256) (if xMode 1 0))<br/> (if xMode (grvecs (list iColor Pt1 Pt3 iColor Pt3 Pt2 iColor Pt2 Pt4 iColor Pt4 Pt1)))<br/>);end_defun</p><p>;;;***************************<br/>;;; 绘制屏幕单向箭头 函数 <br/>;;;***************************<br/>(defun ayGRArw (xPoint xAng xDist xArwLen iColor xMode / Pt0 Pt1 Pt2 Pt11 Pt12 iDist iArwLen iArwWidth aUnit)<br/> (setq aUnit (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))<br/> <br/> (setq iDist (* aUnit xDist))<br/> (setq iArwLen (* aUnit xArwLen))<br/> (setq iArwWidth (* iArwLen 0.325))<br/> <br/> (setq Pt0 xPoint)<br/> (setq Pt1 (polar Pt0 xAng iDist));Arw line end point.<br/> (setq Pt2 (polar Pt1 xAng iArwLen));Arw end-Point.<br/> (setq Pt11 (polar Pt1 (+ xAng (/ PI 2.0)) iArwWidth));Arw Left Point.<br/> (setq Pt12 (polar Pt1 (- xAng (/ PI 2.0)) iArwWidth));Arw Right point.<br/> (grdraw Pt0 Pt1 iColor)<br/> (grdraw Pt11 Pt12 iColor)<br/> (grdraw Pt12 Pt2 iColor)<br/> (grdraw Pt2 Pt11 iColor)<br/> (if xMode (grdraw Pt2 (polar Pt2 xAng 10000.0) iColor 1))<br/> (if xMode (grdraw Pt0 (polar Pt0 (+ PI xAng) 10000.0) iColor 1))<br/>);end_defun</p><p>;;;**************************************<br/>;;; No.24-2 获取曲线最近点/垂足点 函数 <br/>;;;**************************************<br/>(defun ayGetPerPoint (entName1 xPoint / PtonCurve)<br/> (vl-load-com)<br/> (setq PtonCurve (vlax-curve-getClosestPointTo entName1 xPoint nil))<br/>);end_defun</p><p>;;;*******************************<br/>;;; No.24-1 获取曲线切线方向 函数 <br/>;;;*******************************<br/>(defun ayGetTanAngle (entName1 xPoint / fd tAngle)<br/> (vl-load-com)<br/> (setq fd (vlax-curve-getFirstDeriv entName1<br/> (vlax-curve-getparamatpoint entName1<br/> (vlax-curve-getclosestpointto entName1 xPoint))))<br/> (setq tAngle (angle '(0.0 0.0 0.0) fd))<br/>);end_defun</p><p></p>
liminnet
发表于 2008-6-2 11:24:00
liminnet
发表于 2008-6-2 11:48:00
caoyin
发表于 2008-6-2 12:44:00
<p>(if (= #AY_PICKMODETYPE nil) (setq #AY_PICKMODETYPE "Q"))</p><p>-></p><p>(if (= #AY_PICKMODETYPE nil) (setq #AY_PICKMODETYPE "Z"))</p>
liminnet
发表于 2008-6-2 13:07:00
liminnet
发表于 2008-6-4 19:22:00
liminnet
发表于 2008-6-4 21:59:00
页:
[1]