社区 › Auto Lisp › buble上的高度

whosa 发表于 2022-7-5 16:56:01

buble上的高度

你好，
 
我想自动将高度值放入块的文本字符串中
 
该高度值将是P1和P2的z值之间的差值。
 
所以这个lisp应该像这样工作：
 
第一次单击=块的基点
 
第二次点击=P1
 
第三次点击=P2
 
一个月的go Tharwat非常有帮助（再次感谢），为我写了这封信：
 
 
(defun c:spou(/ sp p)
;; Tharwat 15.Feb.2016 ;;
(setq sp
      (vlax-get (vla-get-activelayout
                  (vla-get-ActiveDocument (vlax-get-acad-object)))
                  'Block)
       )
(if (tblsearch "BLOCK" "spotu")
   (while (setq p (getpoint "\nSpecify point :"))

   (vla-put-textstring
       (car (vlax-invoke
            (vla-insertblock
                sp
                (vlax-3d-point p)
                "spotu"
                1.0
                1.0
                1.0
                0.0)
            'getattributes))
      
(rtos (/ (cadr p) 1000.) 2 2)
       )
   )
   )
(princ)
)(vl-load-com)
 
 
也许这是一个很好的起点。
 
 
泡图纸
 
如果有人能帮我，我会很高兴的

maratovich 发表于 2022-7-5 17:06:06

确定要成为属性？
你能用文字吗？还是多行文字？

maratovich 发表于 2022-7-5 17:07:16

这里有相似之处。
http://www.cadtutor.net/forum/showthread.php?98683-自动创建块宏&p=672657#post672657

whosa 发表于 2022-7-5 17:14:49

 
谢谢你的回复
 
我需要一些东西，把高度值（zP1-zP2）从2点击2点，把椭圆周围的数字。如果这是一个块，则属性块或mtex+椭圆将是相同的。

Grrr 发表于 2022-7-5 17:19:28

(defun C:test ( / e o p d )
(setvar 'errno 0)
(and
        vlax-get-acad-object
        (while (/= 52 (getvar 'errno))
                (setq e (car (nentsel "\nSelect text to fill: ")))
                (cond
                        ((= 7 (getvar 'errno))
                                (princ "\nMissed, try again.") (setvar 'errno 0)
                        )
                        ((and e (not (vlax-property-available-p (setq o (vlax-ename->vla-object e)) 'TextString)))
                                (princ "\nThis is not a text object.") (setq e nil)
                        )
                        ((and o (eq (vla-get-Lock (vla-item (vla-get-Layers (vla-get-ActiveDocument (vlax-get-acad-object))) (vla-get-Layer o))) :vlax-true))
                                (princ "\nThis object is on a locked layer.") (setq e nil)
                        )
                        (e
                                (if
                                        (and
                                                (setq p (getpoint "\nSpecify first point: "))
                                                (cadr (setq p (cons p (list (getpoint "\nSpecify second point: " p)))))
                                                (setq d (rtos (abs (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) p))))))
                                        )
                                        (cond
                                                ( (= "ATTDEF" (cdr (assoc 0 (entget e)))) (vla-put-TagString o d) )
                                                ( T (vla-put-TextString o d) )
                                        )
                                )
                                (setvar 'errno 52)
                        )
                        (T nil)
                )
        )
)
(princ)
);| defun |; (or vlax-get-acad-object (vl-load-com)) (princ)

编辑：该死的，我没有注意到Tharwat的代码，你想在填充该属性之前插入块。

whosa 发表于 2022-7-5 17:28:03

这很有效。当我选择块气泡时。dwg，此lisp更改值。非常感谢。你帮了我很大的忙。
 
我想问你是否可能：
 
1、第一次点击->插入块
 
2、在不使用单位的情况下，将精度限制在0.00
 
提前感谢

Grrr 发表于 2022-7-5 17:31:30

我建议您反转输入：
-首先指定距离的2个点
-然后插入块
 

(defun C:test ( / *error* p ar Atts a)
(defun *error* (m) (and ar (setvar 'attreq ar)) (print m) (princ))
(redraw)
(and
        vlax-get-acad-object
        (tblsearch "BLOCK" "spotu")
        (last (setq p (list (getpoint "\nSpecify first point: "))))
        (last (setq p (append p (list (getpoint "\nSpecify second point: " (car p))))))
        (not (apply 'grdraw (append p (list 3 7))))
        (last (setq p (append p (list (getpoint "\nSpecify insertion point :")))))       
        (or
                (= 0 (getvar 'attreq))
                (and (setq ar (getvar 'attreq)) (setvar 'attreq 0))
        )
        (setq Atts
                (vlax-invoke
                        (vla-InsertBlock
                                (vlax-get (vla-get-activelayout (vla-get-ActiveDocument (vlax-get-acad-object))) 'Block)
                                (vlax-3D-point (last p))
                                "spotu"
                                1.0
                                1.0
                                1.0
                                0.0
                        )
                        'GetAttributes
                )
        )
        (setvar 'attreq (if ar ar 0))
        (vl-some '(lambda (x) (and (= (vla-get-TagString x) "22.22") (setq a x))) Atts)
        (vla-put-TextString
                a
                (rtos
                        (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) (cdr (reverse p)))))
                        2 2
                )
        )
)
(redraw)
(princ)
);| defun |; (or vlax-get-acad-object (vl-load-com)) (princ)

所以你不会留下未填充的属性。

whosa 发表于 2022-7-5 17:37:14

这是我想要的工作。
 
非常感谢你。

whosa 发表于 2022-7-5 17:39:49

 
我能以米为单位得到结果吗？现在和我通常的工作单位一样是毫微米级的。
 
在上一个lisp中，转换字符串是
(/       1000.)。

Grrr 发表于 2022-7-5 17:46:58

 
只需更改此行：

(rtos
(apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) (cdr (reverse p)))))
2 2
)

收件人：

(rtos
(/ (apply '- (mapcar 'last (mapcar '(lambda (x) (trans x 1 0)) (cdr (reverse p))))) 1000.)
2 2
)

查看完整版本: buble上的高度