乐筑天下

搜索
欢迎各位开发者和用户入驻本平台 尊重版权,从我做起,拒绝盗版,拒绝倒卖 签到、发布资源、邀请好友注册,可以获得银币 请注意保管好自己的密码,避免账户资金被盗
楼主: Phiphi

[编程交流] 孔ID的Lisp

[复制链接]

5

主题

45

帖子

40

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-6 12:42:00 | 显示全部楼层
谢谢你的快速回复,菲索。
只需上传上一篇文章中的图纸。
PP。
回复

使用道具 举报

1

主题

1069

帖子

1050

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
69
发表于 2022-7-6 12:43:10 | 显示全部楼层
 
你好,PP
试试这个
(请参见命令提示)
 
  1. ;; local defun  
  2. (defun dxf (key elist)
  3. (cdr (assoc key elist))
  4. )
  5. ;;;;; main part  
  6. (defun C:NL (/ *error *base bname color dia ds dxflist elist en layer
  7.        note ort osm pt rad resp sset txtheight
  8.        txtstyle vpt xs xv ys yv)
  9. ;; error trapping routine
  10. (defun *error* (msg)
  11. (if
  12.    (and msg
  13.    (vl-position
  14.      msg
  15.      '("console break"
  16. "Function cancelled"
  17. "quit / exit abort"
  18. )
  19.      )
  20. )
  21.    (princ (strcat "\n** Error: " msg " **"))
  22.    (princ "\nError!")
  23.    )
  24. (command "undo" "end")  
  25. (if osm (setvar "osmode" osm))
  26. (if ort (setvar "orthomode" ort))
  27. (princ)
  28. )
  29. (command "undo" "begin")
  30. (setq osm (getvar "osmode"))
  31. (setvar "osmode" 32)
  32. (setq ort (getvar "orthomode"))
  33. (setvar "orthomode" 0)
  34. (setq txtheight 35.0
  35. txtstyle "ISOCP"
  36. layer "DIMS"
  37. color 2
  38. )
  39. (setq base (getpoint "\nPick base point (red cross): "))
  40. (prompt "\n\t\t\t>>> Select circle or block (or press Enter to Exit) >> ")
  41. (while (setq sset (ssget "+.:E:S" (list (cons -4 "<OR")
  42.     (cons 0 "INSERT")
  43.     (cons 0 "CIRCLE")
  44.     (cons -4 "OR>"))))
  45. (setq en (ssname sset 0)
  46. elist (entget en)
  47. )
  48. (if (eq "CIRCLE" (dxf 0 elist))
  49.    (progn
  50. (setq pt  (dxf 10 elist)
  51.        xv  (abs (- (car base) (car pt)))
  52.        xs  (rtos xv 2 0)
  53.        yv  (abs (- (cadr base) (cadr pt)))
  54.        ys  (rtos yv 2 0)
  55.        rad (dxf 40 elist)
  56.        dia (* rad 2)
  57.        ds  (rtos dia 2 1)
  58.        )
  59.      (command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" ds) pause)
  60. (setq dxflist (entget (entlast))
  61.      vpt (dxf 14 dxflist)
  62.      )
  63. (if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
  64.       (setq dxflist (subst (cons 1 (strcat ds "\t" xs "\t" ys))(assoc 1 dxflist) dxflist))
  65.        (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" ds))(assoc 1 dxflist) dxflist))
  66. )
  67. (entmod dxflist)
  68. (entupd (entlast))
  69.    )
  70.    (progn
  71.      (setq pt   (dxf 10 elist)
  72.     xv   (abs (- (car base) (car pt)))
  73.     xs   (rtos xv 2 0)
  74.     yv   (abs (- (cadr base) (cadr pt)))
  75.     ys   (rtos yv 2 0))
  76.      (setq obj (vlax-ename->vla-object en))
  77.      (vla-getboundingbox obj 'minp 'maxp)
  78.      (setq bp (vlax-safearray->list minp)
  79.     up (vlax-safearray->list maxp)
  80.     dia (abs (- (car up)(car bp)))
  81.     ds   (rtos dia 2 1)
  82.     )
  83.            (command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" ds) pause)
  84. (setq dxflist (entget (entlast))
  85.      vpt (dxf 14 dxflist)
  86.      )
  87. (if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
  88.       (setq dxflist (subst (cons 1 (strcat ds "\t" xs "\t" ys))(assoc 1 dxflist) dxflist))
  89.        (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" ds))(assoc 1 dxflist) dxflist))
  90. )
  91. (entmod dxflist)
  92. (entupd (entlast))
  93.   )
  94. )
  95. )
  96. (initget "Yes No")
  97. (setq resp (getkword "\nDo you want to draw notes? [Yes/No] <Y>: "))
  98. (if (not resp)(setq resp "Yes"))
  99. (if (eq "Yes" resp)
  100.    (progn
  101.      (setvar "osmode" 33)
  102.    (while (setq pt (getpoint "\nPick point (or press Enter to Exit): "))
  103.      (setq note (getstring T "\nEnter note text: "))
  104.      (setq xv (abs (- (car base) (car pt)))
  105.     xs (rtos xv 2 0)
  106.     yv (abs (- (cadr base) (cadr pt)))
  107.     ys (rtos yv 2 0)
  108.     )
  109. (command "_.dimordinate" "_non" pt "_t" (strcat ys "\t" xs "\t" note) pause)
  110. (setq dxflist (entget (entlast))
  111.      vpt (dxf 14 dxflist)
  112.      )
  113. (if  (> (* pi 1.5) (angle pt vpt) (/ pi 2))
  114.       (setq dxflist (subst (cons 1 (strcat note " \t" xs "\t" ys))(assoc 1 dxflist) dxflist))
  115.        (setq dxflist (subst (cons 1 (strcat ys "\t" xs "\t" note))(assoc 1 dxflist) dxflist))
  116. )
  117. (entmod dxflist)
  118. (entupd (entlast))
  119.    )
  120.      )
  121.    )
  122. (*error* nil)
  123. (princ)
  124. )
  125. (vl-load-com)
  126. (prompt "\n   >>>   Type NL to run...")
  127. (prin1)

 
这将仅适用于圆和作为圆形状的块
 
~'J'~
回复

使用道具 举报

5

主题

45

帖子

40

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-6 12:48:36 | 显示全部楼层
谢谢fixo,
圆块的直径似乎有问题。请检查这些图纸。干杯
孔-砌块。图纸
回复

使用道具 举报

1

主题

1069

帖子

1050

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
69
发表于 2022-7-6 12:51:58 | 显示全部楼层
嗨,PP
 
我在上面编辑了lisp
再试一次
 
~'J'~
回复

使用道具 举报

5

主题

45

帖子

40

银币

初来乍到

Rank: 1

铜币
25
发表于 2022-7-6 12:55:25 | 显示全部楼层
非常感谢,菲索。
现在效果很好。
干杯
PP。
回复

使用道具 举报

1

主题

1069

帖子

1050

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
69
发表于 2022-7-6 13:00:26 | 显示全部楼层
 
很乐意帮忙
 
干杯
 
~'J'~
回复

使用道具 举报

发表回复

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

本版积分规则

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

QQ|关于我们|小黑屋|乐筑天下 繁体中文

GMT+8, 2025-7-25 10:22 , Processed in 0.270063 second(s), 62 queries .

© 2020-2025 乐筑天下

联系客服 关注微信 帮助中心 下载APP 返回顶部 返回列表