到属性块的距离
大家好我正在寻找一个lisp来获得从2个点（由用户）的距离，并将结果插入属性块
上网后我发现了这个代码
(defun c:FOO (/ pt)
(if (setq pt (getpoint "\nSpecify base point: "))
(while (and (not (initget 32))
(/= nil (setq pt2 (getpoint pt "\nSpecify point to measure: "))))
(prompt (strcat "\n>>Distance>>" (rtos (distance pt pt2) 2 2))))
(prompt "\n** Invalid point ** "))
(princ))
由BlackBox创建 这可能是一个更好的前端：
(defun c:ptd (/ p1 p2 d3 d2 dx dy dz)
(initget 1)
(setq p1 (getpoint "\n1st Point: "))
(initget 1)
(setq p2 (getpoint p1 "\n2nd Point: "))
(setq d3 (distance p1 p2))
(setq d2 (distance (list (car p1) (cadr p1))
(list (car p2) (cadr p2))))
(princ (strcat "\n3D=" (rtos d3 2 2)
"\t2D=" (rtos d2 2 2)))
(setq dx (- (max (car p1) (car p2)) (min (car p1) (car p2))))
(setq dy (- (max (cadr p1) (cadr p2)) (min (cadr p1) (cadr p2))))
(setq dz (- (max (caddr p1) (caddr p2)) (min (caddr p1) (caddr p2))))
(princ (strcat "\nX Axis:" (rtos dx 2 2)
"\tY Axis:" (rtos dy 2 2)
"\tZ Axis:" (rtos dz 2 2)))
(prin1))
[列表]
[*]一切都是WCS吗？
[*]你有属性块吗？
[*]在价值观和格式方面，你到底在寻找什么？
[/列表]
-大卫 我认为他可能期待着这样的事情：
(defun C:test ( / *error* lst e )
(defun *error* (msg) (princ "\nSorry that I forced you to press Esc, to exit!") (princ))
(if (and (car (setq lst (list (getpoint "\nFirst point: ")))) (apply 'and (setq lst (append lst (list (getpoint "\nSecond point: " (car lst)))))))
(while
(not
(and
(setq e (car (nentsel (strcat "\nDistance to fill is: \"" (rtos (apply 'distance lst)) "\" units, Select text/mtext/attrib."))))
(vl-position (cdr (assoc 0 (entget e))) '("TEXT" "MTEXT" "ATTRIB"))
(not (vl-catch-all-error-p (vl-catch-all-apply 'vla-put-TextString (list (vlax-ename->vla-object e) (rtos (apply 'distance lst))))))
)
)
e
)
)
(princ)
);| defun |; (or vlax-get-acad-object (vl-load-com)) (princ)
非常感谢David Bethel和Grrr：）
与塔尔瓦特私下聊天后：诺沃西：他成功地解决了我的请求
我感谢你的努力
谢谢，就这些 不客气。
页:
[1]