坐标dime的Lisp例程

CraneGuy · 发表于 2022-7-5 22:56:15

你好

我正在寻找一些帮助来创建lisp例程。

我希望从一个特定点创建一个具有X和Y维度的引线。

我找到了一些代码并对其进行了修改以显示英尺和英寸。

出于某种原因，我将UCS设置为我正在标注尺寸的工件的底部中心点，但当我运行lisp例程并选择基点时，我不会得到零值。

我真正想要的是一个例程，它会询问基点，然后让我单击对象周围的点，直到完成。

这是我现在拥有的代码。有人知道为什么我在基点处没有得到零值吗？如果可能的话，例程可以先求基点吗？

谢谢你的帮助。

顺便说一句，我对编程一无所知！

copy


(defun C:xy (/ oldecho pt1 pt2 txtx txty )
(setq oldecho (getvar "cmdecho" ))
(setvar "cmdecho" 0)
(setq pt1 (getpoint "\nPick coordinate point: "))
(if pt1
(progn
(setq pt2 (getpoint pt1 "\nPick text location: "))
(if pt2
(progn
(setq txtx (strcat "W:" (rtos (car pt2) 4 3) " "))
(setq txty (strcat "H:" (rtos (cadr pt2) 4 3) "\n"))
(command "leader" pt1 pt2 "Annotation" txtx txty "")
)
)
)
)
(setvar "cmdecho" oldecho)
(princ)
)

lpseifert · 发表于 2022-7-5 23:20:11

试试这个，没有经过广泛测试

copy


(defun C:xy (/ oldecho pt1 pt2 txtx txty )
(setq oldecho (getvar "cmdecho" ))
(setvar "cmdecho" 0)
(setq ptb (getpoint "Pick base point: "))
(command "ucs" "o" ptb)
(setq pt1 T)
(while  (not (null pt1))
(setq pt1 (getpoint "\nPick coordinate point: "))
(if pt1
(progn
(setq pt2 (getpoint  pt1 "\nPick text location: "))
(if pt2
(progn
(setq txtx (strcat "W:" (rtos (car pt1) 4 3) " "))
(setq txty (strcat "H:" (rtos (cadr pt1) 4 3) "\n"))
(command "leader" pt1 pt2 "Annotation" txtx txty "")
)
)
)
)
);while
(setvar "cmdecho" oldecho)
(princ)
)

CraneGuy · 发表于 2022-7-5 23:30:59

这正是我想要的，谢谢！

它正是我所需要的，但我对格式有几个问题：

有没有办法放大文本周围的方框？我一直在搞乱代码，它似乎要么打开要么关闭。它看起来像是在触摸文本。

可以修改例程以先显示高度，然后显示宽度吗？我在别处找到了一个例程，它将值存储为A1、A2，切换它们很简单。

lpseifert · 发表于 2022-7-5 23:34:34

这将修复H W交换，但对于长方体，这可能是在尺寸样式中设置的。代码无法控制它。
盒子的大小由DIMGAP变量控制；用负数得到一个盒子；我用的是-0.1，在我的电脑上看起来很好，你可能需要实验才能让它看起来像你想要的那样。我添加了几行来设置dimgap。由于没有错误控制，您需要按enter键退出例程，因此Esc不会重置变量。

copy


(defun C:xy (/ oldecho pt1 pt2 txth txtw dg )
(setq oldecho (getvar "cmdecho" )
              dg (getvar "dimgap")
);setq
(setvar "cmdecho" 0)
(setvar "dimgap" -0.1)
(setq ptb (getpoint "Pick base point: "))
(command "ucs" "o" ptb)
(setq pt1 T)
(while  (not (null pt1))
(setq pt1 (getpoint "\nPick coordinate point: "))
(if pt1
(progn
(setq pt2 (getpoint  pt1 "\nPick text location: "))
(if pt2
(progn
(setq txth (strcat "H:" (rtos (cadr pt1) 4 3) " "))
(setq txtw (strcat "W:" (rtos (car pt1) 4 3) "\n"))
(command "leader" pt1 pt2 "Annotation" txth txtw "")
)
)
)
)
);while
(setvar "cmdecho" oldecho)
(setvar "dimgap" dg)
(princ)
)

CraneGuy · 发表于 2022-7-5 23:45:38

再次感谢。这正是我想要的。

dortega4269 · 发表于 2022-7-6 00:01:46

我使用CraneGuy和lpseifert的lisp例程创建了类似的东西，只是稍微修改了代码：
变化：
-H： &W:已切换到x:&y:
-分离的x:&y:lisp（defun C:xy和（defun C:yx）生成“x”或“y”轴坐标尺寸
-消除了文本周围的框（setvar“dimgap”0
-设置默认的DimStyle（命令“-DimStyle”
-添加了层搜索/层创建者（tblesearch“层”）
-将新层设置为当前层（setvar“clayer”）

它工作得很好，我想把它展示给任何其他可能需要这样的东西或给别人更多想法的人。。。
顺便说一句，我是一个n00b的lisp，我只使用的想法，我可以在网上找到并调试它，直到它一起工作得很好。

copy


;;;
;;; ========================= X Ordinates for In-Wall ===========================
;;;
(defun C:xy (/ oldecho pt1 pt2 txtx txty dg )
(setq oldecho (getvar "cmdecho" )
              dg (getvar "dimgap")
);setq
(setvar "cmdecho" 0)
(setvar "dimgap" 0)
(setq ptb (getpoint "Pick base point: "))
(command "ucs" "o" ptb)
(setq pt1 T)
(while  (not (null pt1))
(setq pt1 (getpoint "\nPick coordinate point: "))
(if pt1
(progn
(setq pt2 (getpoint  pt1 "\nPick text location: "))
(if pt2
(progn
(setq txtx (strcat "y:" (rtos (cadr pt1) 4 3) " "))
(setq txty (strcat "x:" (rtos (car pt1) 4 3) "\n"))
(command "-dimstyle" "r" "BLA 32 Ordinates")
(if (null (tblsearch "layer" "B-DimXYOrdinates")) 
(command "-layer" "Make" "B-DimXYOrdinates" "C" "140" "" "L" "Continuous" "" "LW" ".25" "" "D" "B-DimXYOrdinates = Dimensional In-Wall Layout" "B-DimXYOrdinates" "")
(setvar "clayer" "B-DimXYOrdinates")
)
(command "leader" pt1 pt2 "Annotation" txty "")
)
)
)
)
);while
(setvar "cmdecho" oldecho)
(setvar "dimgap" dg)
(princ)
)
;;;
;;; ========================= Y Ordinates for In-Wall ===========================
;;;
(defun C:yx (/ oldecho pt1 pt2 txtx txty dg )
(setq oldecho (getvar "cmdecho" )
              dg (getvar "dimgap")
);setq
(setvar "cmdecho" 0)
(setvar "dimgap" 0)
(setq ptb (getpoint "Pick base point: "))
(command "ucs" "o" ptb)
(setq pt1 T)
(while  (not (null pt1))
(setq pt1 (getpoint "\nPick coordinate point: "))
(if pt1
(progn
(setq pt2 (getpoint  pt1 "\nPick text location: "))
(if pt2
(progn
(setq txtx (strcat "y:" (rtos (cadr pt1) 4 3) " "))
(setq txty (strcat "x:" (rtos (car pt1) 4 3) "\n"))
(command "-dimstyle" "r" "BLA 32 Ordinates")
(if (null (tblsearch "layer" "B-DimXYOrdinates")) 
(command "-layer" "Make" "B-DimXYOrdinates" "C" "140" "" "L" "Continuous" "" "LW" ".25" "" "D" "B-DimXYOrdinates = Dimensional In-Wall Layout" "B-DimXYOrdinates" "")
(setvar "clayer" "B-DimXYOrdinates")
)
(command "leader" pt1 pt2 "Annotation" txtx "")
)
)
)
)
);while
(setvar "cmdecho" oldecho)
(setvar "dimgap" dg)
(princ)
)

[编程交流] 坐标dime的Lisp例程

发表回复

精选推荐