各位大神看一下,求一个复制并放大的功能
输入TT,选择一个要复制的图元,然后点击一个插入cad的点后,完成放大10倍复制这个图元的功能开头不说什么平台使用的,一律拉出去打一百大板 664571221 发表于 2024-4-12 09:17
小星的(defun c:FZFD (/ ss pt0 pt1 ss1)
(setq ss (ssget))
(if (not ss)
(defun c:TT (/ ss pt0 pt1 ss1)
(vl-load-com)
(setq ThisDrawing(vla-get-activedocument (vlax-get-acad-object)))
(Setq TextStyles(vla-get-TextStyles ThisDrawing))
(Setq TextStyle(vla-add TextStyles "新文字样式"))
(vla-SetFont TextStyle "宋体" :vlax-false :vlax-false 1 0)
(setq ss (ssget))
(if (not ss)
(progn
(princ "\n未选择任何实体。")
(exit)
)
)
(setq pt0 (getpoint "\n选择基点:"))
(setq pt1 (getpoint pt0 "\n选择终点:"))
(command "_.copy" ss "" pt0 pt1)
(setq ss1 (entlast))
(command "_.scale" "_l" "" pt1 2)
(command "CHANGE" ss1 "" "p" "c" "1" "")
(setq last_text (entlast)) ; 获取最后创建的实体的实体名
(setq ob (vlax-ename->vla-object last_text)) ; 将最后创建的实体转换为 VLA 对象
(vlax-put-property ob 'StyleName "宋体")
(princ)
) 664571221 发表于 2024-4-12 09:16
(defun c:TT ()
(setq ss (ssget))
(if (not ss)
小星的(defun c:FZFD (/ ss pt0 pt1 ss1)
(setq ss (ssget))
(if (not ss)
(progn
(princ "\n未选择任何实体。")
(exit)
)
)
(setq pt0 (getpoint "\n选择基点:"))
(setq pt1 (getpoint pt0 "\n选择终点:"))
(command "_.copy" ss "" pt0 pt1)
(setq ss1 (entlast))
(command "_.scale" "_l" "" pt1 10)
(command "CHANGE" ss1 "" "p" "c" "1" "")
(princ)
) 我可以跟你写一个加qq 562860217 (defun c:aa ()
(setq ss (ssget))
(setq pt0 (getpoint "选择基点"))
(setq pt1 (getpoint "选择终点" pt0))
(vl-cmdf "copy" ss "" pt0 pt1)
(vl-cmdf "scale"(entlast)""pt1 "r" "" 10)
(princ)
) sniper1111 发表于 2024-4-11 10:27
(defun c:aa ()
(setq ss (ssget))
(setq pt0 (getpoint "选择基点"))
大哥你好,为啥这个在中望里面不起作用,在autocad里面可以用 xj6019 发表于 2024-4-11 12:50
开头不说什么平台使用的,一律拉出去打一百大板
{:1_1:}:(:D-:'(:lol;P:hug: 谢谢分享谢谢分享谢谢分享 664571221 发表于 2024-4-11 12:07
大哥你好,为啥这个在中望里面不起作用,在autocad里面可以用
我没有中望哪位大神帮忙解答一下。 (defun c:aa ()
(setq ss (ssget))
(setq pt0 (getpoint "选择基点"))
(setq pt1 (getpoint "选择终点" pt0))
(command "copy" ss "" pt0 pt1)
(command "scale"(entlast)""pt1 "r" "" 10)
(princ)
)
试试这个!!! copy命令没结束吧。后面要加“”
页:
[1]
2