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

cbssalf

各们楼主，
可不可以用LISP编写个程序在CAD里面自动一个命令，选取圆后，自动根据不同大小的圆而产生不同的孔径符。然后排列出来。

bojuediyi

强烈支持

cbssalf

各位楼主，在明经网站上没有人能解决的难题，
希望各位高手能帮帮忙，小弟谢了！

zml84

请楼主给个图示，如何？

cbssalf

此分孔图为C语言产生出,，请各位高手帮帮忙是否能用LSIP产生出分孔图
谢了

前生

最初由 cbssalf 发布
[B]此分孔图为C语言产生出,，请各位高手帮帮忙是否能用LSIP产生出分孔图
谢了 [/B]

这样的可以吗?

cbssalf

高手可不可以直接发到我的邮箱啊。因为我下载不了啊. 本人的邮箱是：cbssalf@163.com
小弟非常感激，谢了!

zooloo

将所有孔径符制成块，以相应的序号为块名，（图中已作部分），序号与孔径的关系应严格遵照图中的规律（序号=（孔径-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 "" "" ""))))
    )

cbssalf

楼上高手，我想达成下图所示的效果，有劳你帮帮忙，谢了

懒虫

也许是网络原因，发重复了。这个删除了重复内容。

懒虫

"在明经网站上没有人能解决的难题"这种说法太不地道
这个程序其实编起来不难，难的是对功能需求的描述，象前面那样，简单说几句话，没人知道怎么编。
我以前帮别人弄了一个，由于不是做这个的，功能方面不一定合理，供参考。
;这并不能算完整的程序，只是提供个思路
;
(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)
)

cbssalf

多谢了高手，你编写的这个程很好，虽然功能方面没有完整，但能够提供这个思路给我，
我很满足了，太谢谢你了。