模具论坛

 找回密码
 注册

扫一扫,微信登录

QQ登录

只需一步,快速开始

搜索
热搜: 冲压 注塑 求助
    回车查看更多
    论坛可能已存在您要发布的主题帖 关闭
      查看: 4056|回复: 17

      [分享] 几个简单的lisp程序

      [复制链接]
      发表于 2008-6-23 17:15:59 | 显示全部楼层 |阅读模式
      解压后直接用AP加载就可以.

      本帖子中包含更多资源

      您需要 登录 才可以下载或查看,没有帐号?注册

      x

      评分

      1

      查看全部评分

      发表于 2008-6-23 19:14:23 | 显示全部楼层
      谢谢楼主的奉献,彼此交流呵呵
      发表于 2008-6-24 12:00:19 | 显示全部楼层

      ban.lsp

      (defun c:CgH()  ;复制变特性--------------------------------------------
      (setq s (ssget))
      (SETQ CM (getstring "\nINPUT THE LAYER NAME:"))
      (COMMAND "COPY" S "" "0,0" "0,0")
      (COMMAND "CHANGE" S "" "P" "LA" CM "")
         (restore_old_error)  )

      (DEFUN C:PP()  ;连成多义线-----------------------------------------------
      (SETQ SS(SSGET))
      (IF (>(SSLENGTH SS) 1)
           (COMMAND "PEDIT" SS "Y" "J" SS "" "")   )  )

      (defun c:FM()  ;连续倒圆角-----------------------------------------------
        (setq cmd (getvar "cmdecho"))
        (setvar "cmdecho" 0)
            (setq r (getreal "\n Enter fillet radius:"))
            (prompt"\nselect first line:")
            (setq p1 (cadr (entsel)))
            (prompt"\nselect second line:")
            (setq p2 (cadr (entsel)))
            (command "fillet" "r" R "fillet" p1 p2)
         (prompt"\nselect second line:")
         (REPEAT 1000
         (setq p1 (cadr (entsel)))
         (command "fillet" "r" R "fillet" p1 p2)
         (prompt"\nselect second line:")
         (setq p2 (cadr (entsel)))
         (command "fillet" "r" R "fillet" p1 p2)
         (prompt"\nselect second line:")
         (princ))
         (setvar "cmdecho" cmd)   )   

      (defun c:gk();变直径---------------------------------
      (init_bonus_error
          (list
            (list "cmdecho" 0
                  "highlight" 1
            )
            T     ;flag. True means use undo for error clean up.  
          );list  
        );init_bonus_error

      (setq d (getreal "\nDiameter:"))
      (setq s (ssget))
      (while (/= s nil)
      (setq n (sslength s))
      (setq x 0)
      (setq r (/ d 2))
      (while (< x n)
        (setq m (ssname s x))
        (setq m1 (entget m))
        (setq c (cdr (assoc 0 m1)))
        (setq x (+ x 1))
            (IF (= c "CIRCLE")
      (progn
        (setq lay (cdr (assoc 8 m1)))
        (setq ts (tblsearch "layer" lay))
        (setq nn (cdr (assoc 70 ts)))
        (if (/= nn 4)
         (progn
        (setq la (cdr (assoc 40 m1)))
        (setq px (cadr (assoc 10 m1)))
        (setq py (caddr (assoc 10 m1)))
        (setq p1 (list px py))
        (SETQ p(TRANS p1 0 1))
        (setq b (/ r la))
        (command "_.scale" m "" "none" p b)  
        ))      ))
      (princ)     )
      (setq d (getreal "\nDiameter:"))
      (setq s (ssget))  )
      (restore_old_error)  )
       楼主| 发表于 2008-6-26 11:26:18 | 显示全部楼层
      看贴图,JC建层.
       楼主| 发表于 2008-6-26 11:28:18 | 显示全部楼层
      其实这是小厂用的一个很好的图层程序.十分方便快捷,自已也可以修改.
      发表于 2008-8-7 11:34:36 | 显示全部楼层
      还是我的原作呢。
       楼主| 发表于 2008-9-1 21:03:40 | 显示全部楼层
      我来了,请问楼上贵姓.,这个软件是朋友给的.出处不知.我在这是分享.如果是楼上写的,请楼上指正一下,有什么不当的地方,分享出来,大家学习一下.钱是小事,请开声,我转账.(论坛币)
      发表于 2009-4-1 21:29:05 | 显示全部楼层
      那个复制改层的与我写的一模一样(看来大家都想到了),多义线那个我用的是"aj"的命令,倒角我用的快速倒角,如fi0为R0,fi1为R1,ch1为倒直角1*45%%D
      发表于 2009-5-2 08:31:18 | 显示全部楼层

      ALL RIGHT

      ALL RIGHT
      !!!!!!!!!!!1
      发表于 2009-5-2 10:31:00 | 显示全部楼层
      顶几下!!!!!!!!!!!!!!!!!!!!!!!!
      发表于 2010-1-7 16:16:36 | 显示全部楼层
      谢谢啊,下来看看
      发表于 2010-1-18 11:22:25 | 显示全部楼层
      怎样加载到CAD里面啊?谢谢!
      发表于 2010-1-19 11:24:30 | 显示全部楼层
      感谢分享资料。下载试试。
      发表于 2010-1-19 16:01:02 | 显示全部楼层

      頂一下下,沒有用的東東
      发表于 2010-1-25 22:16:25 | 显示全部楼层
      谢谢楼主的奉献,彼此交流呵呵
      发表于 2010-1-28 06:42:57 | 显示全部楼层
      路过...........
      发表于 2010-1-28 08:29:25 | 显示全部楼层
      路过,顶一下,支持国产软件
      您需要登录后才可以回帖 登录 | 注册

      本版积分规则

      关闭

      招聘信息 上一条 /5 下一条

      关闭

      求职信息 上一条 /5 下一条

      关闭

      技术求助 上一条 /5 下一条

      QQ|小黑屋|手机版|模具论坛 ( 浙ICP备15037217号 )

      GMT+8, 2025-7-27 23:49

      Powered by Discuz! X3.4

      © 2001-2013 Comsenz Inc.

      快速回复
      返回顶部
      返回列表
       
      客服电话:0577-61318188
      模具论坛交流群:
      模具论坛交流群
      工作时间:
      08:30-17:30