乐筑天下

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

[编程交流] 调整断点

[复制链接]
chelsea1307

57

主题

351

帖子

294

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
285
发表于 2022-7-6 12:26:37 | 显示全部楼层 |阅读模式
我有一个lisp来插入块，90%都很好，插入的块大小相同，其中一些块会打断插入的线太多，下面的第一个插入很好，第二个在块的边缘（一个圆）和管道（acad中只有一条规则线）之间留有间隙，我连接了块，我知道这与第1和第2部分有关，但我不知道如何将它们改变到正确的点。
 
  1. (defun c:gv (/ *error* scl dis ov vl
  2.                lne pnt ang pt1 pt2)
  4.  ;; Always localise your variables!
  5.  
  6.  (or (not (zerop (setq scl (getvar "DIMSCALE"))))
  7.      (setq scl 1.))
  9.  ;; Dimscale may be zero - need to check for this
  10.  
  11.  (setq dis (* scl 0.0703))
  13.  ;; Use an Error Handler as we are tampering with Sys Vars
  14.  
  15.  (defun *error* (msg)
  16.    (if ov (mapcar 'setvar vl ov)) ; Reset Sys Vars    
  17.    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
  18.      (princ (strcat "\n<< Error: " msg " >>")))
  19.    (princ))
  21.  (setq vl '("CMDECHO" "OSMODE" "CLAYER") ; Sys Var list
  22.        ov (mapcar 'getvar vl)) ; Get Old Sys Var Values
  23.  
  24.  (if (or (tblsearch "BLOCK" "gv") ; Check for Block in Dwg...
  25.          (findfile "gv.dwg"))   ;... And in Search path
  26.    (progn
  27.      
  28.      (while ; While the following returns T
  29.        
  30.        (progn ; Wrap the following expressions
  31.          
  32.          (setq lne (entsel "\nSelect a Line: ")) ; Select a Line
  33.          
  34.          (cond ((null lne) t) ; Stay in Loop
  35.                ((eq "LINE"
  36.                   (cdr (assoc 0 (setq elst (entget (car lne)))))) nil) ; Exit Loop
  37.                (t (princ "\n** Incorrect Selection **"))))) ; Stay in Loop
  38.      
  39.      (if (setq pt (getpoint "\nPick Insertion Point: ")) ; Prompt for Point
  40.        (progn
  41.          (setq ang (angle (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))) ; Get Line Angle
  42.          
  43.          (mapcar 'setvar vl (list 0 0 (cdr (assoc 8 (entget (car lne))))))
  45.          ; Set Sys Vars to how we want them - CMDECHO=0, OSMODE=0, CLAYER= <line layer>
  46.          
  47.          (command "-insert" "gv" pt scl scl (* 180. (/ ang pi))) ; insert Block
  49.          ;; Prefix commands with "_." to make them language compatible
  50.          
  51.          (setq pt1 (polar pt ang dis)
  52.                pt2 (polar pt (- ang pi) dis))
  53.          
  54.          (command "_.break" lne "_F" pt1 pt2))))
  55.    
  56.    (princ "\n<< Block Not Found >>")) ; Else the Block was not found
  57.  
  58.  (mapcar 'setvar vl ov) ; Reset Sys Vars
  59.  
  60.  (princ)) ; Exit Cleanly

 
  1. (defun c:priser (/ *error* scl dis ov vl
  2.                lne pnt ang pt1 pt2)
  4.  ;; Always localise your variables!
  5.  
  6.  (or (not (zerop (setq scl (getvar "DIMSCALE"))))
  7.      (setq scl 1.))
  9.  ;; Dimscale may be zero - need to check for this
  10.  
  11.  (setq dis (* scl 0.0703))
  13.  ;; Use an Error Handler as we are tampering with Sys Vars
  14.  
  15.  (defun *error* (msg)
  16.    (if ov (mapcar 'setvar vl ov)) ; Reset Sys Vars    
  17.    (if (not (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*"))
  18.      (princ (strcat "\n<< Error: " msg " >>")))
  19.    (princ))
  21.  (setq vl '("CMDECHO" "OSMODE" "CLAYER") ; Sys Var list
  22.        ov (mapcar 'getvar vl)) ; Get Old Sys Var Values
  23.  
  24.  (if (or (tblsearch "BLOCK" "priser") ; Check for Block in Dwg...
  25.          (findfile "priser.dwg"))   ;... And in Search path
  26.    (progn
  27.      
  28.      (while ; While the following returns T
  29.        
  30.        (progn ; Wrap the following expressions
  31.          
  32.          (setq lne (entsel "\nSelect a Line: ")) ; Select a Line
  33.          
  34.          (cond ((null lne) t) ; Stay in Loop
  35.                ((eq "LINE"
  36.                   (cdr (assoc 0 (setq elst (entget (car lne)))))) nil) ; Exit Loop
  37.                (t (princ "\n** Incorrect Selection **"))))) ; Stay in Loop
  38.      
  39.      (if (setq pt (getpoint "\nPick Insertion Point: ")) ; Prompt for Point
  40.        (progn
  41.          (setq ang (angle (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))) ; Get Line Angle
  42.          
  43.          (mapcar 'setvar vl (list 0 0 (cdr (assoc 8 (entget (car lne))))))
  45.          ; Set Sys Vars to how we want them - CMDECHO=0, OSMODE=0, CLAYER= <line layer>
  46.          
  47.          (command "-insert" "priser" pt scl scl (* 180. (/ ang pi))) ; insert Block
  49.          ;; Prefix commands with "_." to make them language compatible
  50.          
  51.          (setq pt1 (polar pt ang dis)
  52.                pt2 (polar pt (- ang pi) dis))
  53.          
  54.          (command "_.break" lne "_F" pt1 pt2))))
  55.    
  56.    (princ "\n<< Block Not Found >>")) ; Else the Block was not found
  57.  
  58.  (mapcar 'setvar vl ov) ; Reset Sys Vars
  59.  
  60.  (princ)) ; Exit Cleanly

GV。图纸
普里泽。图纸
回复

使用道具 举报

chelsea1307

57

主题

351

帖子

294

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
285
发表于 2022-7-6 12:56:54 | 显示全部楼层
下图显示了GV（线上的第一个块），线在GV的边缘线处断开，然后显示圆棱镜和不与圆边缘相交的线。我希望他们能像对待GV一样面对边缘
132642w15dk4ed52w6wd45.jpg
回复

使用道具 举报

CarlB

0

主题

269

帖子

279

银币

限制会员

铜币
-4
发表于 2022-7-6 13:26:18 | 显示全部楼层
“priser”块小于GV。
 
在以下行中：
（setq dis（*scl 0.0703）
 
将其更改为：
（setq dis（*scl 0.0469）
 
因为这是棱镜半径的值
回复

使用道具 举报

chelsea1307

57

主题

351

帖子

294

银币

后起之秀

Rank: 20Rank: 20Rank: 20Rank: 20

铜币
285
发表于 2022-7-6 13:36:31 | 显示全部楼层
很抱歉，很长一个周末没有回复。这很好用。。。谢谢
回复

使用道具 举报

返回列表 发帖

发表回复

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

本版积分规则

精选推荐

  • 微信公众平台

  • 扫描访问手机版

  • 点击图片下载手机App

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

GMT+8, 2025-3-5 06:04 , Processed in 0.792069 second(s), 62 queries .

© 2020-2025 乐筑天下

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