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的属性，但这将为您提供手动控制：
 

(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 '("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

(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
页: [1] 2
查看完整版本: 单击并签署坐标