找回密码
 立即注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

查看: 1338|回复: 11

[求助] [求助]:请各位楼主帮忙用LISP编写个分孔图的程序

[复制链接]
发表于 2007-9-14 15:44:43 | 显示全部楼层 |阅读模式

马上注册,结交更多好友,享用更多功能,让你轻松玩转社区。

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

×
各们楼主,
可不可以用LISP编写个程序在CAD里面自动一个命令,选取圆后,自动根据不同大小的圆而产生不同的孔径符。然后排列出来。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
发表于 2007-9-16 14:32:20 | 显示全部楼层
强烈支持
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-17 07:08:01 | 显示全部楼层
各位楼主,在明经网站上没有人能解决的难题,
希望各位高手能帮帮忙,小弟谢了!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 2个

财富等级: 恭喜发财

发表于 2007-9-17 08:24:00 | 显示全部楼层
请楼主给个图示,如何?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-17 22:07:50 | 显示全部楼层
此分孔图为C语言产生出,,请各位高手帮帮忙是否能用LSIP产生出分孔图
谢了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

已领礼包: 8个

财富等级: 恭喜发财

发表于 2007-9-21 19:21:25 | 显示全部楼层
最初由 cbssalf 发布
[B]此分孔图为C语言产生出,,请各位高手帮帮忙是否能用LSIP产生出分孔图
谢了 [/B]


这样的可以吗?
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-21 21:13:40 | 显示全部楼层
高手可不可以直接发到我的邮箱啊。因为我下载不了啊. 本人的邮箱是:cbssalf@163.com
小弟非常感激,谢了!
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2007-9-24 17:22:37 | 显示全部楼层
将所有孔径符制成块,以相应的序号为块名,(图中已作部分),序号与孔径的关系应严格遵照图中的规律(序号=(孔径-0.7)X10),然后运行本程序。孔径超出最大孔径(视是否作有相应的孔径符),或不及最小孔径将出错,重新运行。本程序依赖本图,只能在本图中运行,如果想不在本图运行,要将所有孔径符以相应的序号作图名作出dwg图,放在CAD支持的目录中。
当然,插入点都在中心点。


(defun c:cr (  /  )
     (while (setq yu (entsel "取园"))
    (setq entyu (entget (car yu)))
    (if (= "CIRCLE" (cdr (assoc 0 entyu)))
      (progn
        (setq pt1 (cdr (assoc 10 entyu)))
        (setq yur (cdr (assoc 40 entyu)))
        (setq wname (rtos (* 10 (- (* 2 yur) 0.7)) 2 0))
        (command "_insert" wname pt1 "" "" ""))))
    )
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-24 21:58:00 | 显示全部楼层
楼上高手,我想达成下图所示的效果,有劳你帮帮忙,谢了
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2007-9-25 09:10:39 | 显示全部楼层
也许是网络原因,发重复了。这个删除了重复内容。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

发表于 2007-9-25 09:15:50 | 显示全部楼层
"在明经网站上没有人能解决的难题"这种说法太不地道
这个程序其实编起来不难,难的是对功能需求的描述,象前面那样,简单说几句话,没人知道怎么编。
我以前帮别人弄了一个,由于不是做这个的,功能方面不一定合理,供参考。
;这并不能算完整的程序,只是提供个思路
;
(vl-load-com)
(defun c:bo (/ block block_lis col col_lis sel i i1 i2 cir cir_lis pat_cir_lis tem temlis p
             name name_lis jiaz_date
             b_ins t_ins)
  (defun b_ins (p1 b_name col / ent)
    (if        (null (tblsearch "BLOCK" b_name))
      (progn (command "insert" b_name p1)
             (while (> (getvar "cmdactive") 0) (command ""))
             (entdel (entlast))
      )
    )
    (setq ent '((43 . 1.0) (42 . 1.0) (41 . 1.0) (0 . "INSERT"))
          ent (cons (cons 2 b_name) ent)
          ent (cons (cons 62 col) ent)
          ent (cons (cons 10 p1) ent)
          ent (reverse ent)
    )
    (entmake ent)
  )
  (defun t_ins (p1 s h / ent)
    (setq ent '((67 . 0)(0 . "TEXT"))
          ent (cons (cons 40 h) ent)
          ent (cons (cons 1 s) ent)
          ent (cons (cons 10 p1) ent)
          ent (reverse ent)
    )
    (entmake ent)
  )
  (setq col_lis '(1 3 4 5 6 7));颜色列表
  (setq block_lis'("1" "25" "2" "40" "35" "31" "44" "10" "5" "24" "38" "20" "42" "39" "32" "26" "41" "28" "18" "34" "9" "37" "36" "29" "15" "50" "22" "27" "46" "19" "17" "16" "48" "23" "43" "49" "11" "100"));图块名称列表
  (setq tol 0.001);允许绘图偏差
  
  (setq sel (ssget '((0 . "CIRCLE"))))

  (setq cir_lis '() name_lis '())
  (if (not (null sel))
    (while (setq name (ssname sel 0))
      (setq tem           (entget name)
            temlis (list (assoc 10 tem) (* 2.0 (cdr (assoc 40 tem))))
      )
      (if (not (member temlis cir_lis))
        (setq cir_lis  (cons temlis cir_lis)
              name_lis (cons name name_lis)
        )
      )
      (ssdel name sel)
    )
  )
  (setq cir_lis (mapcar '(lambda (e1 e2) (append e1 (list e2))) cir_lis name_lis))
  ;cir_lis格式:中心点 直径 图元名称

  (setq p (getpoint "\n请输入表格插入位置:"))
  (setq p (trans p 1 0))
  (setq        i  1 ;序列号
        i1 0 ;颜色序列号
        i2 0 ;图块序列号
  )
  (t_ins (mapcar '+ p '(13.75 -10.0 0.0)) "总  和" 3.85)
  (t_ins (mapcar '+ p '(35.5 -3.0 0.0)) "======" 2.75)
  (t_ins (mapcar '+ p '(40 -5.5 0.0)) (rtos (length cir_lis) 2 0) 2.2)
  (setq jiaz_date (getreal "\n请输入加针<手动输入加针结果>:"))
  (while (> (length cir_lis) 0)
    (setq d (cadr (car cir_lis)))
    (foreach cir cir_lis
      (if (< (cadr cir) d)
        (setq d (cadr cir))
      )
    )
    ;(alert (vl-princ-to-string d))
    (setq pat_cir_lis '()
          tem '()
    )
    (foreach cir cir_lis
      (if (equal d (cadr cir) tol)
        (setq pat_cir_lis (cons cir pat_cir_lis))
        (setq tem (cons cir tem))
      )
    )
    (setq cir_lis tem)
    (if        (> (length pat_cir_lis) 0)
      (progn
        ;突出显示此类圆
        (foreach cir pat_cir_lis
          (redraw (caddr cir) 3)
        )
        (redraw)
        ;输入针径;PGH")或(setq s"邮票孔")或(setq s"断线孔"这三样啊
        (if (null jiaz_date)
          (progn
            (setq s (getstring (strcat "\n孔径=" (rtos d 2 3) "输入<孔径(P:PGH, Y:邮票孔, D:断线孔, 其它) ,>针径:")))
            (setq ds (rtos d 2 3))
            (cond
              ((= s "")(setq s "****"))
              ((or (= (substr s 1 2) "P,") (= (substr s 1 2) "p,")) (setq ds "-PGH-" s (substr s 3)))
              ((or (= (substr s 1 3) "P ,") (= (substr s 1 3) "p ,")) (setq ds "-PGH-" s (substr s 4)))
              ((or (= (substr s 1 3) "P,") (= (substr s 1 3) "p,")) (setq ds "-PGH-" s (substr s 4)))
              ((or (= (substr s 1 4) "P ,") (= (substr s 1 4) "p ,")) (setq ds "-PGH-" s (substr s 5)))
              ((or (= (substr s 1 1) "P") (= (substr s 1 1) "p")) (setq ds "-PGH-" s (substr s 2)))

              ((or (= (substr s 1 2) "Y,") (= (substr s 1 2) "y,")) (setq ds "邮票孔" s (substr s 3)))
              ((or (= (substr s 1 3) "Y ,") (= (substr s 1 3) "y ,")) (setq ds "邮票孔" s (substr s 4)))
              ((or (= (substr s 1 3) "Y,") (= (substr s 1 3) "y,")) (setq ds "邮票孔" s (substr s 4)))
              ((or (= (substr s 1 4) "Y ,") (= (substr s 1 4) "y ,")) (setq ds "邮票孔" s (substr s 5)))
              ((or (= (substr s 1 1) "Y") (= (substr s 1 1) "y")) (setq ds "邮票孔" s (substr s 2)))

              ((or (= (substr s 1 2) "D,") (= (substr s 1 2) "d,")) (setq ds "断线孔" s (substr s 3)))
              ((or (= (substr s 1 3) "D ,") (= (substr s 1 3) "d ,")) (setq ds "断线孔" s (substr s 4)))
              ((or (= (substr s 1 3) "D,") (= (substr s 1 3) "d,")) (setq ds "断线孔" s (substr s 4)))
              ((or (= (substr s 1 4) "D ,") (= (substr s 1 4) "d ,")) (setq ds "断线孔" s (substr s 5)))
              ((or (= (substr s 1 1) "D") (= (substr s 1 1) "d")) (setq ds "断线孔" s (substr s 2)))

              ((setq tem (vl-string-search "," s))(setq ds (substr s 1 tem) s (substr s (+ 2 tem))))
              ((setq tem (vl-string-search "," s))(setq ds (substr s 1 tem) s (substr s (+ 3 tem))))

              (T (princ))
            )
            (setq tem (rtos (atof s) 2 2))
            (if (> (strlen tem)(strlen s)) (setq s tem))
          )
          (progn
            (cond
              ((equal d 0.99 0.001) (setq ds "-PGH-" s 1.00))
              ((equal d 1.09 0.001) (setq ds "-PGH-" s 1.10))
              ((equal d 1.29 0.001) (setq ds "-PGH-" s 1.30))
              ((equal d 1.49 0.001) (setq ds "-PGH-" s 1.50))

              ((equal d 1.01 0.001) (setq ds "邮票孔" s 1.00))
              ((equal d 1.31 0.001) (setq ds "邮票孔" s 1.30))
              ((equal d 1.51 0.001) (setq ds "邮票孔" s 1.50))

              ((equal d 1.02 0.001) (setq ds "断线孔" s 1.00))
              ((equal d 1.32 0.001) (setq ds "断线孔" s 1.30))
              ((equal d 1.52 0.001) (setq ds "断线孔" s 1.50))
             
              (T (setq ds (rtos d 2 3) s (+ d jiaz_date)))
            )
            (setq s (rtos s 2 2))
          )
        )
       
        ;(if (null s) (setq s "****")(setq s (rtos s 2 2)))
        ;关闭此类圆突出显示
        (foreach cir pat_cir_lis
          (redraw (caddr cir) 4)
        )
        (redraw)
        ;写序列号 i
        (t_ins p (rtos i 2 0) 2.75)
        ;确定颜色
        (if (setq col (nth i1 col_lis))
          (setq i1 (1+ i1))
          (setq        i1  1
                col (car col_lis)
          )
        )
        ;确定图块名称
        (if (setq block (nth i2 block_lis))
          (setq i2 (1+ i2))
          (setq        i2    1
                block (car block_lis)
          )
        )

        ;表格内插入图块
        (b_ins (mapcar '+ p '(10.45 0.99 0.0)) block col)
        ;写孔径
        (t_ins (mapcar '+ p '(17.75 0.0 0.0)) ds 2.75)
        ;写针径
        (t_ins (mapcar '+ p '(31.6 0.0 0.0)) s 2.75)
        ;写数量
        (t_ins (mapcar '+ p '(43.0 0.0 0.0)) (rtos (length pat_cir_lis) 2 0) 2.75)
        ;图上做标记
        (foreach cir pat_cir_lis
          (b_ins (cdar cir) block col)
        )
        (setq i        (1+ i)
              p        (polar p (/ pi 2.0) 5.5)
        )
      )
    )
  )
  (t_ins (mapcar '+ p '(-2.27 0.0 0.0)) "序号" 2.75)
  (t_ins (mapcar '+ p '(6.68 0.0 0.0)) "符号" 2.75)
  (t_ins (mapcar '+ p '(17.69 0.0 0.0)) "孔径" 2.75)
  (t_ins (mapcar '+ p '(30.83 0.0 0.0)) "针径" 2.75)
  (t_ins (mapcar '+ p '(41.47 0.0 0.0)) "数量" 2.75)
  (if (> i2 (+ (length block_lis) 1)) (alert "  直径类型超过了符号数量,部分符号重复使用了!"))
  (princ)
)
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

 楼主| 发表于 2007-9-26 18:05:40 | 显示全部楼层
多谢了高手,你编写的这个程很好,虽然功能方面没有完整,但能够提供这个思路给我,
我很满足了,太谢谢你了。
论坛插件加载方法
发帖求助前要善用【论坛搜索】功能,那里可能会有你要找的答案;
如果你在论坛求助问题,并且已经从坛友或者管理的回复中解决了问题,请把帖子标题加上【已解决】;
如何回报帮助你解决问题的坛友,一个好办法就是给对方加【D豆】,加分不会扣除自己的积分,做一个热心并受欢迎的人!
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|申请友链|Archiver|手机版|小黑屋|辽公网安备|晓东CAD家园 ( 辽ICP备15016793号 )

GMT+8, 2024-11-6 05:13 , Processed in 0.477653 second(s), 54 queries , Gzip On.

Powered by Discuz! X3.5

© 2001-2024 Discuz! Team.

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