坐标系乐筑天下 - Powered by Discuz! Archiver

Darryl 发表于 2022-7-5 13:20:07

坐标系

你好我不是一个Lisp程序的家伙，我总是找到各种Lisp程序的例程，并将它们混合在一起，以获得我想要的结果，但我对这一个完全不知所措。我需要的是一个lisp例程，该例程将lox单击点的x和y坐标，提供第二次单击以删除具有数值和x和y结果的块，并将引线箭头指向初始单击点。
像往常一样，我发现了一些lisp例程（李·麦克几乎是个天才）完成了部分工作，但我一辈子都不知道如何连接它们。

下面的代码将生成一个显示了X和Y的前导，但我需要将此信息放入一个块中，该块必须包含一个序列号。

(defun c:COOR ( / i l s x )
;; Define function, declare local variable symbols.
;; To understand why variable declaration is important, see http://bit.ly/15Qw104

(setq PNT1 (getpoint
"\nPick coordinate point: "))
(setq P1X (car pnt1)) ;x coord
(setq P1Y (cadr pnt1)) ;y coord
(setq STDX (rtos P1X 2 2))
(setq STDY (rtos P1Y 2 2))
(setq COORDN (strcat "Y " STDY ))
(setq COORDE (strcat "X " STDX ))

(if ;; If we can retrieve a set of attributed blocks
   (setq s ;; Assign the selection set pointer to variable 's'
         (ssget "_X" ;; Search entire database (see http://bit.ly/137NmOJ for more info)
            '(
               (0 . "INSERT") ;; Block References
               (66 . 1) ;; Attributed
               (2 . "coordinate") ;; with name coordinate (this assumes block is non-dynamic)
            )
         ) ;; end SSGET
   ) ;; end SETQ
   (progn
         ;; Evaluate the following expressions and return the result
         ;; of the last expression evaluated. PROGN is used as a
         ;; wrapper function so that we can pass multiple expressions
         ;; to the IF function as a single argument constituting the
         ;; 'then' parameter.

         (initget 6) ;; (+ 2 4): 2=prevent zero, 4=prevent negative
         (if (setq x (getreal "\nEnter first SEQUENCE number: ")) ;; Prompt user for rung number > 0
            (progn
               ;; See above explanation for PROGN

               ;; Construct an association list of attribute tags & values
               ;; to pass to the LM:setattributevalues function
               (setq l
                     (cons
                        (cons "SEQUENCE" (itoa (fix x))) ;; => e.g. ("SEQUENCE" . "2")

                        ;; Use a quoted literal list for the remaining tags/values
                        ;; as there are no expressions to be evaluated.
                        ;; For an explanation of the apostrophe, see http://bit.ly/1bW3rQK
                        '(
                           ("X". "20")
                           ("Y" ."1")
                        )
                     ) ;; end CONS
               ) ;; end SETQ

               ;; The resulting list might look like this:
               ;; l = (("SEQUENCE" . "2") ("X". "20") ("Y" ."1"))

               ;; Repeat the following expressions a number of times
               ;; equal to the number of items in the selection set.
               ;; Note that the numerical argument for the repeat function
               ;; is only evaluated once and hence the integer index variable 'i'
               ;; will only be assigned a value once.
               (repeat (setq i (sslength s))

                     ;; Call the LM:setattributevalues function with the block entity name
                     ;; and association list of attribute tags/values to be set.
                     (LM:SetAttributeValues (ssname s (setq i (1- i))) l)
               ) ;; end REPEAT
            ) ;; end PROGN
         ) ;; end IF
   ) ;; end PROGN

   ;; Else no blocks were found...
   (princ "\nNo \"COORDINATE\" blocks were found.")
) ;; end IF

(princ) ;; Supress the return of the last evaluated expression
) ;; end DEFUN

;; Set Attribute Values-Lee Mac
;; Sets the block attributes whose tags are found in the supplied
;; assocation list to their associated values.
;; Arguments:
;; blk - Block (Insert) Entity Name
;; lst - Association list of ((<TAG> . <Value>) ... )
;; Returns: nil

(defun LM:SetAttributeValues ( blk lst / enx itm )
(if (= "ATTRIB" (cdr (assoc 0 (setq enx (entget (setq blk (entnext blk)))))))
   (if (setq itm (assoc (strcase (cdr (assoc 2 enx))) lst))
         (progn
            (if (entmod (subst (cons 1 (cdr itm)) (assoc 1 enx) enx))
               (entupd blk)
            )
            (LM:SetAttributeValues blk lst)
         )
         (LM:SetAttributeValues blk lst)
   )
)
)

(princ) ;; Suppress the return of any loading expressions

我想在最坏的情况下，我可以完成作业并手动输入序列号。基本上，总承包商坚持要求我提供所有混凝土嵌入件的坐标，数百个，我想使用Autocads导出选项生成所有坐标块的列表；手工出口带来了错误输入的风险，未来可能的修订也会带来同样的风险。。通过块和导出，我们可以为每个绘图生成一个新列表。

有人能帮我吗？

谢谢

dlanorh 发表于 2022-7-5 13:23:30

您需要做两件事，设计并制作一个具有3个属性的块，这些属性对应于序列号、东距和北距。然后制作一个多重引线样式，其中内容是块，而不是多行文字。（参考附图）。MLeader样式的“标准”已修改，因此内容是一个块。在此样式中插入mleader会自动将块作为内容插入。插入多重引线并更新块属性时，很容易获得箭头点坐标。

Darryl 发表于 2022-7-5 13:28:06

制作块很容易，但我不明白的是如何中断insert命令，使属性提示不会弹出，或者如何自动填充这些值。就像我说的，Lisp程序。

Darryl 发表于 2022-7-5 13:30:52

好的，我这里有点烹饪的东西。。

多亏了德拉诺（dlanorh）提出的关于引导块的建议，我没有想到这一点，这绝对是一条更容易的路线。这段代码现在正是我需要的X和Y坐标。我要公开承认，我刚刚搞乱了另一个定义X和Y的lisp，我对代码很糟糕。下一步是尝试使PTXT和coordn之间的第一个属性01随着每次单击增加一个。。。

dlanorh 发表于 2022-7-5 13:34:10

我认为你们需要看看你们的（setq-COORDN）和（setq-COORDE），标签有点不对

至于递增，请考虑

(setq inc_no 1)
...
...
(while (setq PNT1 (getpoint "\nPick coordinate point: "))
....
....
(setq inc_str (itoa inc_no))
(command "mleader" pnt1 ptxt inc_str coordn coorde)
(setq inc_no (1+ inc_no))
);end_while
这将循环插入引线，直到输入一个空条目（按enter键或右键单击鼠标）。每次循环时，它将向inc\u no添加1，然后将其转换为字符串以进行插入。

Darryl 发表于 2022-7-5 13:38:08

你能详细说明一下吗？事实上，我提供的lisp确实产生了通过坐标和坐标填充x和y的预期结果，我不确定在我通过分解和重新组装lisp构建时可能会出现什么错误。

Thakns对于循环的输入，它工作得很好。

这里有一个问题，有没有办法让它查找上一个区块编号，或者提示用户只输入第一个引线的起点？现在，如果我出于任何原因停止，它会在1重新启动。

Darryl 发表于 2022-7-5 13:40:50

答对了

如果你能想出一种改进的方法，我洗耳恭听，但只要用户验证用于确保正确延续的最后一个数字，这就行了。

dlanorh 发表于 2022-7-5 13:44:24

好啊

这是北距坐标（Y轴），但您将其标记为“X”。反之亦然，对于东距坐标。这可能会导致混乱。

坐标是一个东距、一个北距和一个标高，因此需要将其标记为“E”和“N”

关于改进代码，

将任何更改的系统变量重置为lisp输入状态是一种良好的做法。

2、将例程中使用的所有变量声明为局部变量，除非你真的想让它们成为全局变量。这很重要。全局变量可以被当前会话中运行的任何其他LISP读取，并可能产生不可预见的后果。变量inc\u no和inc\u str丢失，您的局部变量中有STDY DY，而它应该是STDY STDX

因此：

6

dlanorh 发表于 2022-7-5 13:46:11

我忘了提一下，你可以像这样把setq组合在一起
7

Darryl 发表于 2022-7-5 13:49:14

非常感谢！明天我将尝试分组，但现在，我已经包括了你的其他笔记，它运行得很好。谢谢你捕捉到了倒转的坐标，我没有做一次适当的试运行，完全错过了。

页: [1] 2

乐筑天下's Archiver

坐标系