明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1529|回复: 7

各位好,求一个小lsp,移动命令

[复制链接]
发表于 2008-5-29 17:38 | 显示全部楼层 |阅读模式
提示: 作者被禁止或删除 内容自动屏蔽
"觉得好,就打赏"
还没有人打赏,支持一下
发表于 2008-6-1 16:35 | 显示全部楼层
本帖最后由 作者 于 2008-6-1 16:37:45 编辑

;;;*****************************************
;;;  By AyungerStudio 2008.06.01           
;;;                                        
;;;  拾取参考点坐标('MM为透明方式)  函数   
;;;*****************************************
(defun C:MM (/ iCross iArw xType Pt1 Pt2 Pt3 oldOsnap EntPick1 Ang1 EntPick2 Ang2)
 (setq oldOsnap (getvar "osmode"))
 (if (= #AY_PICKMODETYPE nil) (setq #AY_PICKMODETYPE "Q"))
 (setq iCross 10.0);像素值.
 (setq iArw 50.0);像素值.
 (initget "Q Z")
 (setq xType (getkword (strcat "\n交点模式 正交(Z)/切线(Q)<" #AY_PICKMODETYPE">: ")))
 (if (= xType nil) (setq xtype #AY_PICKMODETYPE) (setq #AY_PICKMODETYPE xtype))
 (if (= xType "Z")
  (progn;then for xType="Z"
   (setq Pt1 (getpoint "\n指定X参考轴点: "))
   (ayGRCross Pt1 iCross 222 T)
   (ayGRArw Pt1 0.0 iArw (* iArw 0.325) 222 T)
   
   (setq Pt2 (getpoint "\n指定Y参考轴点: "))
   (ayGRCross Pt2 iCross 72 T)
   (ayGRArw Pt2 (* pi 0.5) iArw (* iArw 0.325) 72 T)
   
   (setq Pt3 (list (car Pt2) (cadr Pt1) 0.0))
   (ayGRCross Pt3 iCross 1 T)
   (ayGRCross Pt3 iCross 1 nil)
  );end_progn then
  
  (progn;then for xType="Q"
   (setvar "osmode" 512);Neareast osmode
   (while (not (setq EntPick1 (entsel "\n选择参考轴对象1: "))))
   (setq Pt1 (ayGetPerPoint (car EntPick1) (cadr EntPick1)))
   (setq Ang1 (ayGetTanAngle (car EntPick1) (cadr EntPick1)))
   (ayGRCross Pt1 iCross 222 T)
   (ayGRArw Pt1 Ang1 iArw (* iArw 0.325) 222 T)
   
   (while (not (setq EntPick2 (entsel "\n选择参考轴对象2: "))))
   (setq Pt2 (ayGetPerPoint (car EntPick2) (cadr EntPick2)))
   (setq Ang2 (ayGetTanAngle (car EntPick2) (cadr EntPick2)))
   (ayGRCross Pt2 iCross 72 T)
   (ayGRArw Pt2 Ang2 iArw (* iArw 0.325) 72 T)

   (setq Pt3 (inters Pt1 (polar Pt1 Ang1 1.0)  Pt2 (polar Pt2 Ang2 1.0) nil))
   (if Pt3
    (progn
     (ayGRCross Pt3 iCross 1 T)
     (ayGRCross Pt3 iCross 1 nil)
    );end_progn
    (princ "\n错误: 两切线无交点(平行)!")
   );end_if
   (setvar "osmode" oldOsnap)
  );end_progn else
  );end_if
 (princ)
 (setq Pt3 Pt3)
);end_defun

;;;***************************
;;;   绘制屏幕十字丝  函数   
;;;***************************
(defun ayGRCross (xPoint xCrossLen iColor xMode / iCross aUnit Pt1 Pt2 Pt3 Pt4)
 (setq aUnit (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))
 (setq iCross (* xCrossLen aUnit 0.5))
 (setq Pt1 (polar xPoint 0.0 iCross))
 (setq Pt2 (polar xPoint PI iCross))
 (setq Pt3 (polar xPoint (* PI 0.5) iCross))
 (setq Pt4 (polar xPoint (* PI 1.5) iCross))
 (grdraw (polar xPoint 0.0 iCross) (polar xPoint PI iCross) iColor)
 (grdraw Pt1 Pt2 iColor (if xMode 1 0))
 (grdraw Pt3 Pt4 (rem (+ 10 iColor) 256) (if xMode 1 0))
 (if xMode (grvecs (list iColor Pt1 Pt3  iColor Pt3 Pt2  iColor Pt2 Pt4  iColor Pt4 Pt1)))
);end_defun

;;;***************************
;;;   绘制屏幕单向箭头  函数 
;;;***************************
(defun ayGRArw (xPoint xAng xDist xArwLen iColor xMode / Pt0 Pt1 Pt2 Pt11 Pt12 iDist iArwLen iArwWidth aUnit)
 (setq aUnit (/ (getvar "VIEWSIZE") (cadr (getvar "SCREENSIZE"))))
 
 (setq iDist (* aUnit xDist))
 (setq iArwLen (* aUnit xArwLen))
 (setq iArwWidth (* iArwLen 0.325))
 
 (setq Pt0 xPoint)
 (setq Pt1 (polar Pt0 xAng iDist));Arw line end point.
 (setq Pt2 (polar Pt1 xAng iArwLen));Arw end-Point.
 (setq Pt11 (polar Pt1 (+ xAng (/ PI 2.0)) iArwWidth));Arw Left Point.
 (setq Pt12 (polar Pt1 (- xAng (/ PI 2.0)) iArwWidth));Arw Right point.
 (grdraw Pt0 Pt1 iColor)
 (grdraw Pt11 Pt12 iColor)
 (grdraw Pt12 Pt2 iColor)
 (grdraw Pt2 Pt11 iColor)
 (if xMode (grdraw Pt2 (polar Pt2 xAng 10000.0) iColor 1))
 (if xMode (grdraw Pt0 (polar Pt0 (+ PI xAng) 10000.0) iColor 1))
);end_defun

;;;**************************************
;;; No.24-2 获取曲线最近点/垂足点 函数  
;;;**************************************
(defun ayGetPerPoint (entName1 xPoint / PtonCurve)
 (vl-load-com)
 (setq PtonCurve (vlax-curve-getClosestPointTo entName1 xPoint nil))
);end_defun

;;;*******************************
;;; No.24-1 获取曲线切线方向 函数
;;;*******************************
(defun ayGetTanAngle (entName1 xPoint / fd tAngle)
 (vl-load-com)
  (setq fd  (vlax-curve-getFirstDeriv entName1
       (vlax-curve-getparamatpoint entName1
        (vlax-curve-getclosestpointto entName1 xPoint))))
  (setq tAngle (angle '(0.0 0.0 0.0) fd))
);end_defun

 楼主| 发表于 2008-6-2 11:24 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
 楼主| 发表于 2008-6-2 11:48 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
发表于 2008-6-2 12:44 | 显示全部楼层

(if (= #AY_PICKMODETYPE nil) (setq #AY_PICKMODETYPE "Q"))

->

(if (= #AY_PICKMODETYPE nil) (setq #AY_PICKMODETYPE "Z"))

 楼主| 发表于 2008-6-2 13:07 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
 楼主| 发表于 2008-6-4 19:22 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
 楼主| 发表于 2008-6-4 21:59 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-5-2 08:34 , Processed in 0.253360 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表