[求助]可以帮我写出圆孔孔径符的程式

dnnlog

各位大哥可不可以帮我写出圆孔孔径符的程式??

dnnlog

wltools

原创，

我不是做相关专业的，功能要求是别人提的，具体是否合适我也不太清楚

在其它论坛上同时发布了，

;这并不能算完整的程序，只是提供个思路
;
(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)
 ;输入针径GH")或(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)
)

zoloo

简单的程序,是不是这样的?

(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 "" "" ""))))
 
  )

dnnlog

4楼的还可以,不过改下多个选择!!!