单击并签署坐标

aryanarch · 发表于 2022-7-6 11:16:47

任何人都知道一个lisp在一个点上点击并读取xyz，然后它将相应的内容转换为多行文字

Lee Mac · 发表于 2022-7-6 11:22:55

快速一：


(defun c:mpt (/ M-Point M-Text pt)
 (defun M-Point (pt)
   (entmakex (list (cons 0 "POINT") (cons 10 pt))))
 (defun M-Text (pt val)
   (entmakex (list (cons 0 "MTEXT")
                   (cons 100 "AcDbEntity")
                   (cons 100 "AcDbMText")
                   (cons 10 pt)
                   (cons 1 val))))
 (while (setq pt (getpoint "\nPick Point: "))
   (M-Point (setq pt (trans pt 1 0)))
   (M-Text pt
     (apply 'strcat
       (mapcar 'strcat '("X = " "\nY = " "\nZ = ") (mapcar 'rtos pt)))))
 (princ))

aryanarch · 发表于 2022-7-6 11:26:13

谢谢李，这段代码很有用

Lee Mac · 发表于 2022-7-6 11:27:56

不客气

aryanarch · 发表于 2022-7-6 11:30:39

嗨，李，麦克
你能在这段代码中改变多行文字的高度或旋转吗
因为我创建了一个新的文本样式和新的图层，所以我将设置为当前，但它不适用于此文本样式。。

-----------------------------------------------------------------

Lee Mac · 发表于 2022-7-6 11:34:56

原始代码将采用当前textstyle的属性，但这将为您提供手动控制：

copy


(defun c:mpt (/ M-Point M-Text pt height rotation)
 (setq height 2.5 rotation 0.0) [color=Blue][b];; Text Height and Rotation[/b][/color]
 (defun M-Point (pt)
   (entmakex (list (cons 0 "POINT") (cons 10 pt))))
 (defun M-Text (pt val hgt rot)
   (entmakex (list (cons 0 "MTEXT")
                   (cons 100 "AcDbEntity")
                   (cons 100 "AcDbMText")
                   (cons 10 pt)
                   (cons 1 val)
                   (cons 40 hgt)
                   (cons 50 rot))))
 (while (setq pt (getpoint "\nPick Point: "))
   (M-Point (setq pt (trans pt 1 0)))
   (M-Text pt
     (apply 'strcat
       (mapcar 'strcat '("X = " "\nY = " "\nZ = ") (mapcar 'rtos pt)))
           height rotation))
 (princ))

stevesfr · 发表于 2022-7-6 11:38:08

如何将输出改为Y、X、Z？

Lee Mac · 发表于 2022-7-6 11:41:49

copy

(defun c:mpt (/ M-Point M-Text pt height rotation)
 (setq height 2.5 rotation 0.0) ;; Text Height and Rotation
 (defun M-Point (pt)
   (entmakex (list (cons 0 "POINT") (cons 10 pt))))
 (defun M-Text (pt val hgt rot)
   (entmakex (list (cons 0 "MTEXT")
                   (cons 100 "AcDbEntity")
                   (cons 100 "AcDbMText")
                   (cons 10 pt)
                   (cons 1 val)
                   (cons 40 hgt)
                   (cons 50 rot))))
 (while (setq pt (getpoint "\nPick Point: "))
   (M-Point (setq pt (trans pt 1 0)))
   (M-Text pt
     (apply 'strcat
       (mapcar 'strcat '("Y = " "\nX = " "\nZ = ")
         (mapcar 'rtos (list (cadr pt) (car pt) (caddr pt)))))
           height rotation))
 (princ))

stevesfr · 发表于 2022-7-6 11:42:15

李，谢谢你上了关于rtos使用的课！现在，我可以将所有其他生成的“xyz”程序修复为“yxz”（对我来说，它是N，E，Elev）！！

Lee Mac · 发表于 2022-7-6 11:46:12

不客气Steve

[编程交流] 单击并签署坐标

发表回复

精选推荐