明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 1222|回复: 4

圆圈编号 大神们在好好完善下吧

[复制链接]
发表于 2019-6-3 21:29 | 显示全部楼层 |阅读模式
  1. ;;;;;;;;;;;;;;;;;
  2. (defun insertgc ( e / e)
  3.   (cdr(assoc 10(entget e)))
  4.   )
  5. ;;;;





  6. (defun cx-ss2en
  7.   (ss / enlst)
  8.   (cond
  9.     ((= (type ss) 'PICKSET)
  10.       (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
  11.     )
  12.     ((= (type ss) 'LIST)
  13.       (setq enlst (ssadd))
  14.       (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
  15.     )
  16.     ((='ename(type ss))
  17.       (ssadd ss)
  18.     )
  19.   )
  20. )
  21.   ;;;;;;;;;;;;;;;;;;
  22. (defun t2t (p1 p2 p3 / p1 p2 p3) ;点到直线距离1
  23.   

  24.   (abs (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1))))
  25.   
  26. )   ;;;;;;;;;;;;;;;;

  27. (defun t1t (p1 p2 p3 / p1 p2 p3) ;点到直线距离2
  28.   

  29.    (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1)))
  30.   
  31. )

  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33. (defun c:szpx (/ ssa kongbiao i ii zb paixuzb p1 p2 fgjj p3 cishu kb kbb iii iiii wenzi)
  34. (setq ssa (ssget '( (0 . "circle")  (8 . "0") ) ) )
  35. (setq kongbiao '()) (setq i 0)
  36. (foreach x (cx-ss2en ssa)
  37.      
  38.     (setq zb (insertgc x)) (setq kongbiao (append (list zb) kongbiao)) (setq i (1+ i))
  39.   )

  40. (setq paixuzb (vl-sort kongbiao
  41.              (function (lambda (e1 e2)      (> (cadr e1)(cadr e2 ) )   
  42.               ) ) )
  43.        )
  44. (setq p1 (getpoint "\n请选择直线起点:"))
  45.   (setq p2 (getpoint "\n请选择直线第二点:"))
  46. (setq fgjj (getREAL "\n请输入方格间距(输入数):"));输入整数
  47.   (setq p3 (last paixuzb))
  48. (setq cishu (+ 2 (fix (/ (t2t p1 p2 p3) fgjj )  ) ) )
  49. (setq kb '()) (setq ii 0)
  50. (repeat cishu
  51.    

  52. (setq kbb
  53. (vl-sort (vl-remove-if-not  (FUNCTION (LAMBDA (A1) (< (* -1 fgjj) (t1t (polar p1 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) (polar p2 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) A1) 0) ))  kongbiao)
  54.              (function (lambda (e1 e2)      (> (car e1)(car e2 ) )   (< (cadr e1)(cadr e2 ) )
  55.               ) ) )

  56. )  (print kbb)
  57.   (setq iiii 0)
  58. (FOREACH x kbb
  59.   (setq iiii (1+ iiii))

  60.   (setq wenzi (strcat (vl-prin1-to-string  ii) "-" (vl-prin1-to-string  iiii)))

  61.   (entmake (list '(0 . "TEXT") '(8 . "fgbaj")(cons 1 wenzi) (cons 10 x ) (cons 40 0.250)))
  62.   )
  63.   
  64. (setq kb (append kbb kb))

  65. (setq ii (1+ ii))


  66.   )
  67.   (setq iii 0)
  68. (foreach n (reverse kb)


  69.    ;(entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos (+ iii 1) 2 0)) (cons 10 n ) (cons 40 0.250)))
  70.   ;(entmake (list '(0 . "circle") '(8 . "fgbj")(cons 62 3) (cons 10 n ) (cons 40 0.25)))
  71. (setq iii (1+ iii))

  72.   )

  73. (princ)
  74. )

本帖子中包含更多资源

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

x
 楼主| 发表于 2019-6-3 21:50 | 显示全部楼层
另外一种不同效果的
  1. ;;;;;;;;;;;;;;;;;
  2. (defun insertgc ( e / e)
  3.   (cdr(assoc 10(entget e)))
  4.   )
  5. ;;;;





  6. (defun cx-ss2en
  7.   (ss / enlst)
  8.   (cond
  9.     ((= (type ss) 'PICKSET)
  10.       (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
  11.     )
  12.     ((= (type ss) 'LIST)
  13.       (setq enlst (ssadd))
  14.       (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
  15.     )
  16.     ((='ename(type ss))
  17.       (ssadd ss)
  18.     )
  19.   )
  20. )
  21.   ;;;;;;;;;;;;;;;;;;
  22. (defun t2t (p1 p2 p3 / p1 p2 p3) ;点到直线距离1
  23.   

  24.   (abs (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1))))
  25.   
  26. )   ;;;;;;;;;;;;;;;;

  27. (defun t1t (p1 p2 p3 / p1 p2 p3) ;点到直线距离2
  28.   

  29.    (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1)))
  30.   
  31. )

  32. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  33. (defun c:szpx (/ ssa kongbiao i ii zb paixuzb p1 p2 fgjj p3 cishu kb kbb iii iiii wenzi x n )
  34. (setq ssa (ssget '( (0 . "circle")  (8 . "0") ) ) )
  35. (setq kongbiao '()) (setq i 0)
  36. (foreach x (cx-ss2en ssa)
  37.      
  38.     (setq zb (insertgc x)) (setq kongbiao (append (list zb) kongbiao)) (setq i (1+ i))
  39.   )

  40. (setq paixuzb (vl-sort kongbiao
  41.              (function (lambda (e1 e2)      (> (cadr e1)(cadr e2 ) )   
  42.               ) ) )
  43.        )
  44. (setq p1 (getpoint "\n请选择直线起点:"))
  45.   (setq p2 (getpoint "\n请选择直线第二点:"))
  46. (setq fgjj (getREAL "\n请输入方格间距(输入数):"));输入整数
  47.   (setq p3 (last paixuzb))
  48. (setq cishu (+ 2 (fix (/ (t2t p1 p2 p3) fgjj )  ) ) )
  49. (setq kb '() ) (setq ii 0)
  50. (repeat cishu
  51.    

  52. (setq kbb
  53. (vl-sort (vl-remove-if-not  (FUNCTION (LAMBDA (A1) (< (* -1 fgjj) (t1t (polar p1 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) (polar p2 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) A1) 0) ))  kongbiao)
  54.              (function (lambda (e1 e2)      (> (car e1)(car e2 ) )   (< (cadr e1)(cadr e2 ) )
  55.               ) ) )

  56. ) ; (print kbb)
  57.   
  58.   
  59. (setq kb (append (list kbb) kb))

  60. (setq ii (1+ ii))


  61.   )  (print (car kb))
  62.   (setq iii 0)
  63. (foreach n kb

  64. (setq iiii 0)
  65. (FOREACH x n
  66.   (setq iiii (1+ iiii))

  67.   (setq wenzi (strcat (vl-prin1-to-string  iii) "-" (vl-prin1-to-string  iiii)))

  68.   (entmake (list '(0 . "TEXT") '(8 . "fgbaj")(cons 1 wenzi) (cons 10 x ) (cons 40 0.250)))
  69.   )
  70.   

  71.    ;(entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos (+ iii 1) 2 0)) (cons 10 n ) (cons 40 0.250)))
  72.   ;(entmake (list '(0 . "circle") '(8 . "fgbj")(cons 62 3) (cons 10 n ) (cons 40 0.25)))
  73. (setq iii (1+ iii))

  74.   )

  75. (princ)
  76. )

发表于 2019-6-4 05:35 来自手机 | 显示全部楼层
文字长度能否跟圆的半径扯上点关系,对正方式也改下
发表于 2019-6-4 05:38 来自手机 | 显示全部楼层
实际上不用画出那条线来第一排的两端的圆即可判断了
您需要登录后才可以回帖 登录 | 注册

本版积分规则

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

GMT+8, 2024-3-29 19:26 , Processed in 0.211803 second(s), 27 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

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