乐筑天下

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

[编程交流] 测量或分割对象-wit

[复制链接]
CafeJr

27

主题

182

帖子

163

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
139
发表于 2022-7-6 03:30:15 | 显示全部楼层 |阅读模式
伙计们，
 
我很好奇，有人知道如何使用命令：测量或分割。
 
我需要在一条追踪线上分布一个块，但它们之间的空间相同，这些命令会放置距离，因此，当作为参考的对象发生倾斜时，距离跟随对象，但最终距离有一个小错误，因为倾斜度。。。下面我在一些图片中展示了我试图解释的内容，有人知道一个LISP代码可以帮上忙吗？
 
谢谢
 
043019hsi1a3yss0rr2bbg.jpg
043021rqd92udrzlqrz7z2.jpg
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 03:38:55 | 显示全部楼层
试试这个快速破解：
 
  2. ([color=BLUE]defun[/color] c:mymeasure ( [color=BLUE]/[/color] di en in ln ob p1 p2 sn sp x1 )
  3.    ([color=BLUE]while[/color]
  4.        ([color=BLUE]progn[/color]
  5.            ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect object to measure: "[/color])))
  6.            ([color=BLUE]cond[/color]
  7.                (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
  8.                    ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
  9.                )
  10.                (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))
  11.                    ([color=BLUE]if[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-curve-getendparam[/color] ([color=BLUE]list[/color] en)))
  12.                        ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid object selected."[/color])
  13.                    )
  14.                )
  15.            )
  16.        )
  17.    )
  18.    ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))
  19.            ([color=BLUE]progn[/color]
  20.                ([color=BLUE]initget[/color] 6)
  21.                ([color=BLUE]setq[/color] di ([color=BLUE]getdist[/color] [color=MAROON]"\nSpecify length of segment: "[/color]))
  22.            )
  23.        )
  24.        ([color=BLUE]progn[/color]
  25.            ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getstartpoint[/color] en)
  26.                  p2 ([color=BLUE]vlax-curve-getendpoint[/color]   en)
  27.                  x1 ([color=BLUE]abs[/color] ([color=BLUE]-[/color] ([color=BLUE]car[/color] p2) ([color=BLUE]car[/color] p1)))
  28.                  sn ([color=BLUE]fix[/color] ([color=BLUE]/[/color] x1 di))
  29.                  x1 ([color=BLUE]+[/color] ([color=BLUE]min[/color] ([color=BLUE]car[/color] p1) ([color=BLUE]car[/color] p2)) ([color=BLUE]/[/color] ([color=BLUE]-[/color] x1 ([color=BLUE]*[/color] di sn)) 2.0))
  30.                  ob ([color=BLUE]vlax-ename->vla-object[/color] en)
  31.                  sp ([color=BLUE]vlax-get-property[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
  32.                         ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport))
  33.                             'paperspace
  34.                             'modelspace
  35.                         )
  36.                     )
  37.            )
  38.            ([color=BLUE]repeat[/color] ([color=BLUE]1+[/color] sn)
  39.                ([color=BLUE]setq[/color] ln ([color=BLUE]vlax-invoke[/color] sp 'addline ([color=BLUE]list[/color] x1 0.0 0.0) ([color=BLUE]list[/color] x1 1.0 0.0)))
  40.                ([color=BLUE]if[/color] ([color=BLUE]setq[/color] in ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ln [color=BLUE]acextendotherentity[/color]))
  41.                    ([color=BLUE]entmake[/color] ([color=BLUE]list[/color] '(0 . [color=MAROON]"POINT"[/color]) ([color=BLUE]list[/color] 10 ([color=BLUE]car[/color] in) ([color=BLUE]cadr[/color] in) ([color=BLUE]caddr[/color] in))))
  42.                )
  43.                ([color=BLUE]vla-delete[/color] ln)
  44.                ([color=BLUE]setq[/color] x1 ([color=BLUE]+[/color] x1 di))
  45.            )
  46.        )
  47.    )
  48.    ([color=BLUE]princ[/color])
  49. )
  50. ([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])
回复

使用道具 举报

amarcon

2

主题

18

帖子

16

银币

初来乍到

Rank: 1

铜币
10
发表于 2022-7-6 03:47:33 | 显示全部楼层
这是一个很好的例程，但是我们怎么能用“BLOCKNAME”代替你的“entmake POINT”？
谢谢
回复

使用道具 举报

CafeJr

27

主题

182

帖子

163

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
139
发表于 2022-7-6 04:03:38 | 显示全部楼层
哇。。。非常感谢“李麦克”！。。。这正是我需要的！。。。我只需要将点名称交换到一个块，以便在我的应用程序上更快！。。。但是它帮了我很多！！！。。。
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 04:07:26 | 显示全部楼层
不客气
 
尝试以下操作，更改高亮显示的块名称以适合：
  2. ([color=BLUE]defun[/color] c:mymeasure ( [color=BLUE]/[/color] *error* bd bn cm di en in ln ob p1 p2 sn sp x1 )
  4.    ([color=BLUE]setq[/color] bn [color=MAROON][highlight]"myblock"[/highlight][/color]) [color=GREEN];; Name of block to insert[/color]
  6.    ([color=BLUE]defun[/color] *error* ( msg )
  7.        ([color=BLUE]if[/color] ([color=BLUE]and[/color] ([color=BLUE]=[/color] 'vla-object ([color=BLUE]type[/color] ln)) ([color=BLUE]not[/color] ([color=BLUE]vlax-erased-p[/color] ln)))
  8.            ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vla-delete[/color] ([color=BLUE]list[/color] ln))
  9.        )
  10.        ([color=BLUE]if[/color] ([color=BLUE]=[/color] 'int ([color=BLUE]type[/color] cm))
  11.            ([color=BLUE]setvar[/color] 'cmdecho cm)
  12.        )
  13.        ([color=BLUE]if[/color] ([color=BLUE]not[/color] ([color=BLUE]wcmatch[/color] ([color=BLUE]strcase[/color] msg [color=BLUE]t[/color]) [color=MAROON]"*break,*cancel*,*exit*"[/color]))
  14.            ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nError: "[/color] msg))
  15.        )
  16.        ([color=BLUE]princ[/color])
  17.    )
  19.    ([color=BLUE]cond[/color]
  20.        (   ([color=BLUE]=[/color] 4 ([color=BLUE]logand[/color] 4 ([color=BLUE]cdr[/color] ([color=BLUE]assoc[/color] 70 ([color=BLUE]tblsearch[/color] [color=MAROON]"layer"[/color] ([color=BLUE]getvar[/color] 'clayer))))))
  21.            ([color=BLUE]princ[/color] [color=MAROON]"\nCurrent layer locked."[/color])
  22.        )
  23.        (   ([color=BLUE]not[/color]
  24.                ([color=BLUE]or[/color] ([color=BLUE]tblsearch[/color] [color=MAROON]"block"[/color] bn)
  25.                    ([color=BLUE]and[/color] ([color=BLUE]setq[/color] bd ([color=BLUE]findfile[/color] ([color=BLUE]strcat[/color] bn [color=MAROON]".dwg"[/color])))
  26.                        ([color=BLUE]progn[/color]
  27.                            ([color=BLUE]setq[/color] cm ([color=BLUE]getvar[/color] 'cmdecho))
  28.                            ([color=BLUE]setvar[/color] 'cmdecho 0)
  29.                            ([color=BLUE]command[/color] [color=MAROON]"_.-insert"[/color] bd [color=BLUE]nil[/color])
  30.                            ([color=BLUE]setvar[/color] 'cmdecho cm)
  31.                            ([color=BLUE]tblsearch[/color] [color=MAROON]"block"[/color] bn)
  32.                        )
  33.                    )
  34.                )
  35.            )
  36.            ([color=BLUE]princ[/color] ([color=BLUE]strcat[/color] [color=MAROON]"\nBlock ""[/color] bn [color=MAROON]"" not found."[/color]))
  37.        )
  38.        (   ([color=BLUE]progn[/color]
  39.                ([color=BLUE]while[/color]
  40.                    ([color=BLUE]progn[/color]
  41.                        ([color=BLUE]setvar[/color] 'errno 0) ([color=BLUE]setq[/color] en ([color=BLUE]car[/color] ([color=BLUE]entsel[/color] [color=MAROON]"\nSelect object to measure: "[/color])))
  42.                        ([color=BLUE]cond[/color]
  43.                            (   ([color=BLUE]=[/color] 7 ([color=BLUE]getvar[/color] 'errno))
  44.                                ([color=BLUE]princ[/color] [color=MAROON]"\nMissed, try again."[/color])
  45.                            )
  46.                            (   ([color=BLUE]=[/color] 'ename ([color=BLUE]type[/color] en))
  47.                                ([color=BLUE]if[/color] ([color=BLUE]vl-catch-all-error-p[/color] ([color=BLUE]vl-catch-all-apply[/color] '[color=BLUE]vlax-curve-getendparam[/color] ([color=BLUE]list[/color] en)))
  48.                                    ([color=BLUE]princ[/color] [color=MAROON]"\nInvalid object selected."[/color])
  49.                                )
  50.                            )
  51.                        )
  52.                    )
  53.                )
  54.                ([color=BLUE]/=[/color] 'ename ([color=BLUE]type[/color] en))
  55.            )
  56.        )
  57.        (   ([color=BLUE]progn[/color]
  58.                ([color=BLUE]initget[/color] 6)
  59.                ([color=BLUE]setq[/color] di ([color=BLUE]getdist[/color] [color=MAROON]"\nSpecify length of segment: "[/color]))
  60.            )
  61.            ([color=BLUE]setq[/color] p1 ([color=BLUE]vlax-curve-getstartpoint[/color] en)
  62.                  p2 ([color=BLUE]vlax-curve-getendpoint[/color]   en)
  63.                  x1 ([color=BLUE]abs[/color] ([color=BLUE]-[/color] ([color=BLUE]car[/color] p2) ([color=BLUE]car[/color] p1)))
  64.                  sn ([color=BLUE]fix[/color] ([color=BLUE]/[/color] x1 di))
  65.                  x1 ([color=BLUE]+[/color] ([color=BLUE]min[/color] ([color=BLUE]car[/color] p1) ([color=BLUE]car[/color] p2)) ([color=BLUE]/[/color] ([color=BLUE]-[/color] x1 ([color=BLUE]*[/color] di sn)) 2.0))
  66.                  ob ([color=BLUE]vlax-ename->vla-object[/color] en)
  67.                  sp ([color=BLUE]vlax-get-property[/color] ([color=BLUE]vla-get-activedocument[/color] ([color=BLUE]vlax-get-acad-object[/color]))
  68.                         ([color=BLUE]if[/color] ([color=BLUE]=[/color] 1 ([color=BLUE]getvar[/color] 'cvport))
  69.                             'paperspace
  70.                             'modelspace
  71.                         )
  72.                     )
  73.            )
  74.            ([color=BLUE]repeat[/color] ([color=BLUE]1+[/color] sn)
  75.                ([color=BLUE]setq[/color] ln ([color=BLUE]vlax-invoke[/color] sp 'addline ([color=BLUE]list[/color] x1 0.0 0.0) ([color=BLUE]list[/color] x1 1.0 0.0)))
  76.                ([color=BLUE]if[/color] ([color=BLUE]setq[/color] in ([color=BLUE]vlax-invoke[/color] ob 'intersectwith ln [color=BLUE]acextendotherentity[/color]))
  77.                    ([color=BLUE]vlax-invoke[/color] sp 'insertblock ([color=BLUE]mapcar[/color] '[color=BLUE]+[/color] in '(0.0 0.0 0.0)) bn 1.0 1.0 1.0 0.0)
  78.                )
  79.                ([color=BLUE]vla-delete[/color] ln)
  80.                ([color=BLUE]setq[/color] x1 ([color=BLUE]+[/color] x1 di))
  81.            )
  82.        )
  83.    )
  84.    ([color=BLUE]princ[/color])
  85. )
  86. ([color=BLUE]vl-load-com[/color]) ([color=BLUE]princ[/color])
回复

使用道具 举报

CafeJr

27

主题

182

帖子

163

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
139
发表于 2022-7-6 04:13:54 | 显示全部楼层
“李麦克”！。。。它工作得很好！。。。谢谢！！！。。。
回复

使用道具 举报

CafeJr

27

主题

182

帖子

163

银币

初露锋芒

Rank: 3Rank: 3Rank: 3

铜币
139
发表于 2022-7-6 04:28:20 | 显示全部楼层
我在代码中添加了一个小问题以获得块名：
 
  1. (defun c:mymeasure ( / *error* bd bn cm di en in ln ob p1 p2 sn sp x1 )
  2.    ;(setq bn "Botão") ; Name of block to insert ("myblock")
  3.    [color=red](setq bn (getstring "\nEnter with block Name: "))[/color]
  4.    (defun *error* ( msg )
  6.      (if (and (= 'vla-object (type ln)) (not (vlax-erased-p ln)))
  7.            (vl-catch-all-apply 'vla-delete (list ln))
  8.        )
  9.        (if (= 'int (type cm))
  10.            (setvar 'cmdecho cm)
  11.        )
  12.        (if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
  13.            (princ (strcat "\nError: " msg))
  14.        )
  15.        (princ)
  16.    )
  17.    (cond
  18.        (   (= 4 (logand 4 (cdr (assoc 70 (tblsearch "layer" (getvar 'clayer))))))
  19.            (princ "\nCurrent layer locked.")
  20.        )
  21.        (   (not
  22.                (or (tblsearch "block" bn)
  23.                    (and (setq bd (findfile (strcat bn ".dwg")))
  24.                        (progn
  25.                            (setq cm (getvar 'cmdecho))
  26.                            (setvar 'cmdecho 0)
  27.                            (command "_.-insert" bd nil)
  28.                            (setvar 'cmdecho cm)
  29.                            (tblsearch "block" bn)
  30.                        )
  31.                    )
  32.                )
  33.            )
  34.            (princ (strcat "\nBlock "" bn "" not found."))
  35.        )
  36.        (   (progn
  37.                (while
  38.                    (progn
  39.                        (setvar 'errno 0) (setq en (car (entsel "\nSelect object to measure: ")))
  40.                        (cond
  41.                            (   (= 7 (getvar 'errno))
  42.                                (princ "\nMissed, try again.")
  43.                            )
  44.                            (   (= 'ename (type en))
  45.                                (if (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getendparam (list en)))
  46.                                    (princ "\nInvalid object selected.")
  47.                                )
  48.                            )
  49.                        )
  50.                    )
  51.                )
  52.                (/= 'ename (type en))
  53.            )
  54.        )
  55.        (   (progn
  56.                (initget 6)
  57.                (setq di (getdist "\nSpecify length of segment: "))
  58.            )
  59.            (setq p1 (vlax-curve-getstartpoint en)
  60.                  p2 (vlax-curve-getendpoint   en)
  61.                  x1 (abs (- (car p2) (car p1)))
  62.                  sn (fix (/ x1 di))
  63.                  x1 (+ (min (car p1) (car p2)) (/ (- x1 (* di sn)) 2.0))
  64.                  ob (vlax-ename->vla-object en)
  65.                  sp (vlax-get-property (vla-get-activedocument (vlax-get-acad-object))
  66.                         (if (= 1 (getvar 'cvport))
  67.                             'paperspace
  68.                             'modelspace
  69.                         )
  70.                     )
  71.            )
  72.            (repeat (1+ sn)
  73.                (setq ln (vlax-invoke sp 'addline (list x1 0.0 0.0) (list x1 1.0 0.0)))
  74.                (if (setq in (vlax-invoke ob 'intersectwith ln acextendotherentity))
  75.                    (vlax-invoke sp 'insertblock (mapcar '+ in '(0.0 0.0 0.0)) bn 1.0 1.0 1.0 0.0)
  76.                )
  77.                (vla-delete ln)
  78.                (setq x1 (+ x1 di))
  79.            )
  80.        )
  81.    )
  82.    (princ)
  83. )
  84. (vl-load-com) (princ)
回复

使用道具 举报

Lee Mac

114

主题

1万

帖子

1万

银币

中流砥柱

Rank: 25

铜币
543
发表于 2022-7-6 04:30:22 | 显示全部楼层
不客气！
回复

使用道具 举报

返回列表 发帖

发表回复

高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-10 18:24 , Processed in 0.490683 second(s), 71 queries .

© 2020-2025 乐筑天下

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