帮助：宏脚本或lisp到

vernonlee · 发表于 2022-7-5 21:45:23

正在查找可以在单个命令中执行以下操作的宏或lisp：-

1.画一个十字（使用defpoint图层，但颜色变为绿色）
-纸上空间环境
-十字架长度约5mm
2.将此十字的中心放置在点0,0处

目的是帮助我直观地看到标题bk是否对齐到0,0。

或者，如果autocad中有本机命令，请执行advise。

谢谢

Tharwat · 发表于 2022-7-5 21:51:02

有了lisp程序，生活变得很简单。试试这个lisp程序，让我知道。

copy


(defun c:cross nil
;; Tharwat 27.Nov.2014   ;;
 (mapcar '(lambda (x)
            (entmake (list '(0 . "LINE")
                           '(8 . "Defpoints")
                           '(62 . 3)
                           (cons 10 (polar '(0. 0. 0.) (car x) 5.))
                           (cons 11 (polar '(0. 0. 0.) (cadr x) 5.))
                     )
            )
          )
         '((0.785398 3.92699) (2.35619 5.49778))
 )
 (princ)
)

vernonlee · 发表于 2022-7-5 21:54:30

凉的但我意识到它太小了。如何将十字改为50mm？

谢谢

Tharwat · 发表于 2022-7-5 21:59:35

只需将例程中的数字5改为50即可。

例如

copy


(cons 10 (polar '(0. 0. 0.) (car x) [color="blue"]50.[/color]))
(cons 11 (polar '(0. 0. 0.) (cadr x) [color="blue"]50.[/color]))

vernonlee · 发表于 2022-7-5 22:01:52

太棒了，兄弟。非常感谢

Tharwat · 发表于 2022-7-5 22:05:16

非常欢迎你

ttray33y · 发表于 2022-7-5 22:08:10

还有，我的变长NOOB例程

copy


(setq l1 "100,0,0") ;sets the second point of the line
(defun c:test () 
(setvar "filedia" 0)
(setvar "cmdecho" 1)
(setvar "orthomode" 1)
(setq cl1 (getstring (strcat "\nEnter Line X, <" l1 ">: ")))
(if (= cl1 "")
    (setq cl1 l1)
    (setq l1 cl1)
)
(command "clayer" "Defpoints")
(command "celtype" "Bylayer")
(command "line" "0,0,0" l1 "" "")
(command "-array" "l" "" "p" "0,0,0" "4" "" "")
(command "zoom" "C" "0,0,0" "250")
(setvar "filedia" 1)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(princ)
)

BIGAL · 发表于 2022-7-5 22:10:21

为什么不选取块并只显示两行代码的偏移量呢

copy


(setq obj (entget (car (entsel "\nPick title block"))))
(alert (strcat "Title block is at   " (rtos (car (assoc 10 obj)) 2 1) "," (rtos (cadr (assoc 10 obj)) 2 1 )))

好的，阅读你的另一篇文章，所以你需要的是离开，检查dwg中的所有标题栏，根据需要移动，然后运行绘图宏。看看我有没有时间。

这件事已经接近尾声了

copy


; moves all objects in pspace to 0,0 alignment
; By BIG AL
; moves all objects in pspace to 0,0 alignment
(setq doc (vla-get-activedocument (vlax-get-acad-object)))
(vlax-for lay (vla-get-Layouts doc)
 (setq plotabs (cons (vla-get-name lay) plotabs))
)
(setq plottablist (acad_strlsort plotabs))
(setq len (length plottablist))
(setq oldsnap (getvar "osmode")) 
(setvar "osmode" 0)
(setq en (entsel "Pick Title Block:"))
(setq  ed (entget (car en)))
(setq K 0)
(repeat len
 (setq name (nth K plottablist))
 (princ name)
 (if (/= name "Model")
   (progn
   (setvar "ctab" name)
   (setq minxy  (getvar "extmin"))
   (setq maxxy (getvar "extmax"))
   (setq ss (ssget "_X" (list (cons 0 "INSERT")  (cons 410 name) (cons 2 (cdr (assoc 2 ed))) ) ))
   (setq n (sslength ss))
   (setq en (ssname ss 0))
   (setq xy (assoc 10 (entget en)))
 ; insertion pt   (setq xy (assoc 10 el)) 
   (setq xy (list (cadr xy)(caddr xy)))
   (command "move" "w" minxy maxxy  "" xy "0,0")
   (command "zoom" "E")
   ) ;end progn
) ; end if
(setq K (+ K 1))
(princ k)
(setq ss nil)
(setq xy nil)
) ; end repeat
(setvar "osmode" oldsnap)
(princ)

vernonlee · 发表于 2022-7-5 22:14:01

谢谢ttray33y。另一个有趣的Lisp程序。我不想输入任何东西，但你的Lisp程序也是守门员。

vernonlee · 发表于 2022-7-5 22:17:53

如果我输入正确，上面的lisp会将图纸空间中的所有内容移动到0,0,0？我尝试了上面的代码并选择了标题栏，然后出现了以下错误

顺便问一下，lisp如何知道捕捉图形的范围以及应该移动到标题栏的哪个点？

此外，交叉的目的是快速检查标题栏是否位于0,0,0。

[编程交流] 帮助：宏脚本或lisp到

发表回复

精选推荐