求输入TT，画线，线宽图纸缩放时显示的宽度不变，类似BQCZ这样的外框的线

664571221

求输入TT，画线，线宽图纸缩放时显示的宽度不变，类似BQCZ这样的外框的线，线的图层名为  你好123

弥勒

(defun c:tt()
       (setq lst '() )
       (setq pt1 (getpoint  " 起点："))
       (setq x1 (car pt1))
       (setq y1 (cadr pt1))
       (setq lsta (list x1 y1) )
       (setq lst  (cons  lsta lst  ) )
       (while (setq pt (getpoint pt1 " 下一点："))
          (setq x (car pt))
          (setq y (cadr pt))
          (setq lst1 (list x y) )
          (setq lst  (cons  lst1 lst  ) )
          (command "line" pt1 pt "")
          (setq pt1 pt)
       )
       (entmake (append (list '(0 . "LWPOLYLINE")
                                        '(100 . "AcDbEntity")
                                        '(8 . "你好123")
                                        '(370 . 90)
                                        '(100 . "AcDbPolyline")
                                         (cons 90 (length lst))
                                   )
                        (mapcar '(lambda (pt)(cons 10 pt)) lst )
                    )
         )
        (princ)
)
(princ "\n程序加载完成")
(princ "\n")

飞雪神光

有画线的过程

1. (defun c:tt (/ pt set-dxf ty)
   
2.         (defun set-dxf (ename code val / ent)
   
3.                 (setq ent (entget ename))
   
4.                 (if (and (listp code) (listp val))
   
5.                         (mapcar '(lambda (x y) (set-dxf ename x y)) code val)
   
6.                         (progn
   
7.                                 (if (assoc code ent)
   
8.                                         (setq ent (subst (cons code val) (assoc code ent) ent))
   
9.                                         (setq ent (append ent (list (cons code val))))
   
10.                                 )
    
11.                                 (entmod ent)
    
12.                                 (entupd ename)
    
13.                         )
    
14.                 )
    
15.                 ename
    
16.         )
    
17.         (setq pt(getpoint"\n下一点:"))
    
18.         (command "pline" pt)
    
19.   (while (NOT (ZEROP (GETVAR "cmdactive"))) (command PAUSE))
    
20.         (setq ty (entlast))
    
21.         (set-dxf ty '(8 370) '("你好123" 90))
    
22.         (princ)
    
23. )

(defun c:tt (/ pt set-dxf ty)<br />         (defun set-dxf (ename code val / ent)<br />                 (setq ent (entget ename))<br />                 (if (and (listp code) (listp val))<br />                         (mapcar '(lambda (x y) (set-dxf ename x y)) code val)<br />                         (progn<br />                                 (if (assoc code ent)<br />                                         (setq ent (subst (cons code val) (assoc code ent) ent))<br />                                         (setq ent (append ent (list (cons code val))))<br />                                 )<br />                                 (entmod ent)<br />                                 (entupd ename)<br />                         )<br />                 )<br />                 ename<br />         )<br />         (setq pt(getpoint"\n下一点:"))<br />         (command "pline" pt)<br />   (while (NOT (ZEROP (GETVAR "cmdactive"))) (command PAUSE))<br />         (setq ty (entlast))<br />         (set-dxf ty '(8 370) '("你好123" 90))<br />         (princ)<br /> )

嘒彼小星

664571221 发表于 2024-1-29 18:22
好像不能用

可以用。根据楼上的改了一下。

1. (defun c:tt(/ lts pt)
   
2.         (command "UNDO" "be")
   
3.         (setq lst '())
   
4.         (setq pt (getpoint "指定起点："))
   
5.         (setq lst (cons pt lst))
   
6.                 (while (setq pt (getpoint pt " 下一点："))
   
7.                         (setq lst (cons pt lst))
   
8.                 )
   
9.                         (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")'(8 . "你好123") '(100 . "AcDbPolyline") (cons 90 (length lst))) (mapcar '(lambda (pt)(cons 10 pt)) lst )))
   
10.         (command "UNDO" "e")
    
11. )
    
12. (princ "\n程序加载完成,命令TT")
    
13. (princ)

(defun c:tt(/ lts pt)<br />         (command "UNDO" "be")<br />         (setq lst '())<br />         (setq pt (getpoint "指定起点："))<br />         (setq lst (cons pt lst))<br />                 (while (setq pt (getpoint pt " 下一点："))<br />                         (setq lst (cons pt lst))<br />                 )<br />                         (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")'(8 . "你好123") '(100 . "AcDbPolyline") (cons 90 (length lst))) (mapcar '(lambda (pt)(cons 10 pt)) lst )))<br />         (command "UNDO" "e")<br /> )<br /> (princ "\n程序加载完成,命令TT")<br /> (princ)

弥勒

；爱编程的小和尚
(defun c:tt()
        (vl-load-com)
       (setq lst '())
       (setq pt ' (0 0))
           (while (setq pt (getpoint pt " 下一点："))
          (setq x (car pt))
          (setq y (cadr pt))
          (setq lst1 (list x y) )
          (setq lst  (cons  lst1 lst  ) )
       )
      (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity")'(8 . "你好123")  '(370 . 90)'(100 . "AcDbPolyline") (cons 90 (length lst))) (mapcar '(lambda (pt)(cons 10 pt)) lst )) )
        (princ)
)
(princ "\n程序加载完成")
(princ "\n")

弥勒

听高人说，要多用ENTMAKE，听人劝，吃饱饭。vegetaria

664571221

弥勒 发表于 2024-1-29 17:52
；爱编程的小和尚
(defun c:tt()
        (vl-load-com)

谢谢小和尚

664571221

弥勒 发表于 2024-1-29 17:52
；爱编程的小和尚
(defun c:tt()
        (vl-load-com)

好像不能用

飞雪神光

线宽图纸缩放时显示的宽度不变 是不是图越小时  就感觉线宽越大那样 而不是全局宽度？

弥勒

664571221 发表于 2024-1-29 18:21
谢谢小和尚

阿弥陀佛，能用，不太好用，但满足要求，TT 画粗线，图层。

664571221

弥勒 发表于 2024-1-29 21:31
阿弥陀佛，能用，不太好用，但满足要求，TT 画粗线，图层。

好像可以用，就是不显示画线的过程，还有一直显示0.0点那个虚线