插件修改

l982414603

各位大神们，帮忙修改一下插件，让它默认为虚线[X]线型，颜色为6，不要每次都要输入X命令，太麻烦了

tigcat

tigcat 发表于 2021-8-15 14:45
楼主:1、虚线的线型名是“dash”还是什么？
2、现在的颜色是红色?不像要红色？

(defun c:kc (/ *error* ang l1 ltype mpt1 os out pt1 pt2 pt3 ptlst)
  (defun *error* (msg)
    (if        (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
      (setvar "OSMODE" os)
    )
    (princ)
  )
;;;;;;----------------------------------------------------
  (setq os (getvar "OSMODE"))
  (setvar "OSMODE" 1025)
;;;        (initget "X")
;;;        (setq pt1 (getpoint "\n第一点[虚线< X >]："))
;;;        (cond
;;;                ((or (equal pt1 "x") (equal pt1 "X"))
  (while (setq pt1 (getpoint "\n第一点："))
    (setq pt2        (getpoint pt1 "\n第二点[相邻点]：")
          pt3        (getcorner pt1 "\n第三点[对角点]：")
          L1        (distance pt1 pt2)
          ang        (angle pt2 pt1)
          mpt1        (polar pt3 ang (* 0.5 L1))
          ptlst        (list pt1 mpt1 pt2)
          Ltype        (vlax-for each
                          (vla-get-Linetypes
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                  (setq out (cons (vla-get-Name each) out))
                )
    )
    (if        (member "JIS_09_15" ltype)
      (entmake (append
                 (list '(0 . "LWPOLYLINE")
                       '(100 . "AcDbEntity")
                       '(100 . "AcDbPolyline")
                       (cons 6 "JIS_09_15")
                       (cons 62 6)
                       (cons 90 (length ptlst))
                 )
                 (mapcar '(lambda (x) (cons 10 x)) ptlst)
               )
      )
      (progn
        (vla-Load (vla-get-Linetypes
                    (vla-get-ActiveDocument (vlax-get-acad-object))
                  )
                  "JIS_09_15"
                  (findfile "acadiso.lin")
        )
        (entmake (append
                   (list '(0 . "LWPOLYLINE")
                         '(100 . "AcDbEntity")
                         '(100 . "AcDbPolyline")
                         (cons 6 "JIS_09_15")
                         (cons 62 6)
                         (cons 90 (length ptlst))
                   )
                   (mapcar '(lambda (x) (cons 10 x)) ptlst)
                 )
        )
      )
    )
  )
;;;                )
;;;                (T
;;;                        (while pt1
;;;                                (setq pt2 (getpoint pt1 "\n第二点[相邻点]：")
;;;                                        pt3 (getcorner pt1 "\n第三点[对角点]：")
;;;                                        L1 (distance pt1 pt2)
;;;                                        ang (angle pt2 pt1)
;;;                                        mpt1 (polar pt3 ang (* 0.5 L1))
;;;                                        ptlst (list pt1 mpt1 pt2)
;;;                                )
;;;                                (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length ptlst))) (mapcar '(lambda (x) (cons 10 x)) ptlst)))
;;;                                (setq pt1 (getpoint "\n第一点："))
;;;                        )
;;;                )

  (setvar "OSMODE" os)
  (princ)
)

tigcat

l982414603 发表于 2021-8-16 08:11
感谢，就是要这种效果，请问怎么设置线宽为0.09

1. ;202108162107修改
   
2. (defun c:kc (/ *error* ang l1 ltype mpt1 os out pt1 pt2 pt3 ptlst os1)
   
3.   (defun *error* (msg)
   
4.     (if        (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
   
5.       (progn
   
6.       (setvar "OSMODE" os)
   
7.       (setvar "PLINEWID" os1)
   
8.       )
   
9.     )
   
10.     (princ)
    
11.   )
    
12. ;;;;;;----------------------------------------------------
    
13.   (setq os (getvar "OSMODE"))
    
14.     (setq os1 (getvar "plinewid"))
    
15.   (setvar "OSMODE" 1025)
    
16. ;;;    (setvar "plinewid" 0.09)
    
17. ;;;        (initget "X")
    
18. ;;;        (setq pt1 (getpoint "\n第一点[虚线< X >]："))
    
19. ;;;        (cond
    
20. ;;;                ((or (equal pt1 "x") (equal pt1 "X"))
    
21.   (while (setq pt1 (getpoint "\n第一点："))
    
22.     (setq pt2        (getpoint pt1 "\n第二点[相邻点]：")
    
23.           pt3        (getcorner pt1 "\n第三点[对角点]：")
    
24.           L1        (distance pt1 pt2)
    
25.           ang        (angle pt2 pt1)
    
26.           mpt1        (polar pt3 ang (* 0.5 L1))
    
27.           ptlst        (list pt1 mpt1 pt2)
    
28.           Ltype        (vlax-for each
    
29.                           (vla-get-Linetypes
    
30.                             (vla-get-activedocument (vlax-get-acad-object))
    
31.                           )
    
32.                   (setq out (cons (vla-get-Name each) out))
    
33.                 )
    
34.     )
    
35.     (if        (member "JIS_09_15" ltype)
    
36.       (entmake (append
    
37.                  (list '(0 . "LWPOLYLINE")
    
38.                        '(100 . "AcDbEntity")
    
39.                        '(100 . "AcDbPolyline")
    
40.                        (cons 6 "JIS_09_15")
    
41.                        (cons 62 6)
    
42.                        (cons 43 0.09)
    
43.                        (cons 90 (length ptlst))
    
44.                  )
    
45.                  (mapcar '(lambda (x) (cons 10 x)) ptlst)
    
46.                )
    
47.       )
    
48.       (progn
    
49.         (vla-Load (vla-get-Linetypes
    
50.                     (vla-get-ActiveDocument (vlax-get-acad-object))
    
51.                   )
    
52.                   "JIS_09_15"
    
53.                   (findfile "acadiso.lin")
    
54.         )
    
55.         (entmake (append
    
56.                    (list '(0 . "LWPOLYLINE")
    
57.                          '(100 . "AcDbEntity")
    
58.                          '(100 . "AcDbPolyline")
    
59.                          (cons 6 "JIS_09_15")
    
60.                          (cons 43 0.09)
    
61.                          (cons 62 6)
    
62.                          (cons 90 (length ptlst))
    
63.                    )
    
64.                    (mapcar '(lambda (x) (cons 10 x)) ptlst)
    
65.                  )
    
66.         )
    
67.       )
    
68.     )
    
69.   )
    
70. ;;;                )
    
71. ;;;                (T
    
72. ;;;                        (while pt1
    
73. ;;;                                (setq pt2 (getpoint pt1 "\n第二点[相邻点]：")
    
74. ;;;                                        pt3 (getcorner pt1 "\n第三点[对角点]：")
    
75. ;;;                                        L1 (distance pt1 pt2)
    
76. ;;;                                        ang (angle pt2 pt1)
    
77. ;;;                                        mpt1 (polar pt3 ang (* 0.5 L1))
    
78. ;;;                                        ptlst (list pt1 mpt1 pt2)
    
79. ;;;                                )
    
80. ;;;                                (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length ptlst))) (mapcar '(lambda (x) (cons 10 x)) ptlst)))
    
81. ;;;                                (setq pt1 (getpoint "\n第一点："))
    
82. ;;;                        )
    
83. ;;;                )
    
84. 
    
85.   (setvar "OSMODE" os)
    
86.     (SETVAR "plinewid" os1)
    
87.   (princ)
    
88. )
    
89.   (prompt "\n******程序运行命令<kc>******")
    
90.   (prin1)

;202108162107修改<br /> (defun c:kc (/ *error* ang l1 ltype mpt1 os out pt1 pt2 pt3 ptlst os1)<br />   (defun *error* (msg)<br />     (if        (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))<br />       (progn<br />       (setvar "OSMODE" os)<br />       (setvar "PLINEWID" os1)<br />       )<br />     )<br />     (princ)<br />   )<br /> ;;;;;;----------------------------------------------------<br />   (setq os (getvar "OSMODE"))<br />     (setq os1 (getvar "plinewid"))<br />   (setvar "OSMODE" 1025)<br /> ;;;    (setvar "plinewid" 0.09)<br /> ;;;        (initget "X")<br /> ;;;        (setq pt1 (getpoint "\n第一点[虚线< X >]："))<br /> ;;;        (cond <br /> ;;;                ((or (equal pt1 "x") (equal pt1 "X"))<br />   (while (setq pt1 (getpoint "\n第一点："))<br />     (setq pt2        (getpoint pt1 "\n第二点[相邻点]：")<br />           pt3        (getcorner pt1 "\n第三点[对角点]：")<br />           L1        (distance pt1 pt2)<br />           ang        (angle pt2 pt1)<br />           mpt1        (polar pt3 ang (* 0.5 L1))<br />           ptlst        (list pt1 mpt1 pt2)<br />           Ltype        (vlax-for each<br />                           (vla-get-Linetypes<br />                             (vla-get-activedocument (vlax-get-acad-object))<br />                           )<br />                   (setq out (cons (vla-get-Name each) out))<br />                 )<br />     )<br />     (if        (member "JIS_09_15" ltype)<br />       (entmake (append<br />                  (list '(0 . "LWPOLYLINE")<br />                        '(100 . "AcDbEntity")<br />                        '(100 . "AcDbPolyline")<br />                        (cons 6 "JIS_09_15")<br />                        (cons 62 6)<br />                        (cons 43 0.09)<br />                        (cons 90 (length ptlst))<br />                  )<br />                  (mapcar '(lambda (x) (cons 10 x)) ptlst)<br />                )<br />       )<br />       (progn<br />         (vla-Load (vla-get-Linetypes<br />                     (vla-get-ActiveDocument (vlax-get-acad-object))<br />                   )<br />                   "JIS_09_15"<br />                   (findfile "acadiso.lin")<br />         )<br />         (entmake (append<br />                    (list '(0 . "LWPOLYLINE")<br />                          '(100 . "AcDbEntity")<br />                          '(100 . "AcDbPolyline")<br />                          (cons 6 "JIS_09_15")<br />                          (cons 43 0.09)<br />                          (cons 62 6)<br />                          (cons 90 (length ptlst))<br />                    )<br />                    (mapcar '(lambda (x) (cons 10 x)) ptlst)<br />                  )<br />         )<br />       )<br />     )<br />   )<br /> ;;;                )<br /> ;;;                (T <br /> ;;;                        (while pt1<br /> ;;;                                (setq pt2 (getpoint pt1 "\n第二点[相邻点]：")<br /> ;;;                                        pt3 (getcorner pt1 "\n第三点[对角点]：")<br /> ;;;                                        L1 (distance pt1 pt2)<br /> ;;;                                        ang (angle pt2 pt1)<br /> ;;;                                        mpt1 (polar pt3 ang (* 0.5 L1))<br /> ;;;                                        ptlst (list pt1 mpt1 pt2)<br /> ;;;                                )<br /> ;;;                                (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 (length ptlst))) (mapcar '(lambda (x) (cons 10 x)) ptlst)))<br /> ;;;                                (setq pt1 (getpoint "\n第一点："))<br /> ;;;                        )<br /> ;;;                )<br /> <br />   (setvar "OSMODE" os)<br />     (SETVAR "plinewid" os1)<br />   (princ)<br /> )<br />   (prompt "\n******程序运行命令<kc>******")<br />   (prin1)

tigcat

楼主:1、虚线的线型名是“dash”还是什么？
2、现在的颜色是红色?不像要红色？

tigcat

另外来一个简单版,没加入循环处理,局部变量,出错处理,线型若不存在也没有加载行为.楼主自行更改下.

1. (defun c:tt ()
   
2.   (setvar "cmdecho" 0)
   
3.   (setq oldos (getvar 'osmode))
   
4.   (setvar 'osmode 0)
   
5.   (princ "\n选择画框的多段线(仅研究4条边4个顶点的情况):")
   
6.   (setq en (entsel))
   
7.   (setq pt (cadr en))
   
8.   (setq ptm (osnap pt "mid"))
   
9.   ;;;(setq en (ssname (ssget ":s:e" '((0 . "LWPOLYLINE"))) 0))
   
10.   (setq en_data (entget (car en)))
    
11.   (setq ptv nil)
    
12.   (foreach x en_data
    
13.     (if  (= (car x) 10)
    
14.       (setq ptv (cons (cdr x) ptv))
    
15.     )
    
16.   )
    
17.   (setq vt1 (nth 0 ptv))
    
18.   (setq vt2 (nth 1 ptv))
    
19.   (setq vt3 (nth 2 ptv))
    
20.   (setq vt4 (nth 3 ptv))
    
21.   (cond ( (equal (angle ptm vt4) (angle vt3 vt4) 1e-5)
    
22.    (setq ptj1 vt1)
    
23.    (setq ptj2 vt2)
    
24.    )
    
25.   ( (equal (angle ptm vt2) (angle vt1 vt2) 1e-5)
    
26.    (setq ptj1 vt3)
    
27.    (setq ptj2 vt4)
    
28.    )
    
29.          ( (equal (angle ptm vt3) (angle vt2 vt3) 1e-5)
    
30.    (setq ptj1 vt4)
    
31.    (setq ptj2 vt1)
    
32.    )
    
33.    ( (equal (angle ptm vt1) (angle vt4 vt1) 1e-5)
    
34.    (setq ptj1 vt2)
    
35.    (setq ptj2 vt3)
    
36.    )
    
37.   ) ;|end cond|;
    
38.   (setq ptlst (list ptj1 ptm ptj2))
    
39.   (entmake (append
    
40.      (list '(0 . "LWPOLYLINE")
    
41.            '(100 . "AcDbEntity")
    
42.            '(100 . "AcDbPolyline")
    
43.            (cons 6 "dash")
    
44.            (cons 62 6)
    
45.            (cons 90 (length ptlst))
    
46.      )
    
47.      (mapcar '(lambda (x) (cons 10 x)) ptlst)
    
48.          )
    
49.       )
    
50. ;;;  (c:tt)
    
51.   (prin1)   
    
52. )

(defun c:tt ()<br />   (setvar "cmdecho" 0)<br />   (setq oldos (getvar 'osmode))<br />   (setvar 'osmode 0)<br />   (princ "\n选择画框的多段线(仅研究4条边4个顶点的情况):")<br />   (setq en (entsel))<br />   (setq pt (cadr en))<br />   (setq ptm (osnap pt "mid"))<br />   ;;;(setq en (ssname (ssget ":s:e" '((0 . "LWPOLYLINE"))) 0))<br />   (setq en_data (entget (car en)))<br />   (setq ptv nil)<br />   (foreach x en_data<br />     (if  (= (car x) 10)<br />       (setq ptv (cons (cdr x) ptv))<br />     )<br />   )<br />   (setq vt1 (nth 0 ptv))<br />   (setq vt2 (nth 1 ptv))<br />   (setq vt3 (nth 2 ptv))<br />   (setq vt4 (nth 3 ptv))<br />   (cond ( (equal (angle ptm vt4) (angle vt3 vt4) 1e-5)<br />    (setq ptj1 vt1)<br />    (setq ptj2 vt2)<br />    )<br />   ( (equal (angle ptm vt2) (angle vt1 vt2) 1e-5)<br />    (setq ptj1 vt3)<br />    (setq ptj2 vt4)<br />    )<br />          ( (equal (angle ptm vt3) (angle vt2 vt3) 1e-5)<br />    (setq ptj1 vt4)<br />    (setq ptj2 vt1)<br />    )<br />    ( (equal (angle ptm vt1) (angle vt4 vt1) 1e-5)<br />    (setq ptj1 vt2)<br />    (setq ptj2 vt3)<br />    )<br />   ) ;|end cond|;<br />   (setq ptlst (list ptj1 ptm ptj2))<br />   (entmake (append<br />      (list '(0 . "LWPOLYLINE")<br />            '(100 . "AcDbEntity")<br />            '(100 . "AcDbPolyline")<br />            (cons 6 "dash")<br />            (cons 62 6)<br />            (cons 90 (length ptlst))<br />      )<br />      (mapcar '(lambda (x) (cons 10 x)) ptlst)<br />          )<br />       )<br /> ;;;  (c:tt)<br />   (prin1)   <br /> )

tigcat

tigcat 发表于 2021-8-15 19:50
另外来一个简单版,没加入循环处理,局部变量,出错处理,线型若不存在也没有加载行为.楼主自行更改下.

最后觉得你直接画多段线不是更快，直接选好颜色线型，点3个点不就出来一个多段线，要这代码费事？

l982414603

tigcat 发表于 2021-8-15 15:27
(defun c:kc (/ *error* ang l1 ltype mpt1 os out pt1 pt2 pt3 ptlst)
  (defun *error* (msg)
   ...

感谢，就是要这种效果，请问怎么设置线宽为0.09

l982414603

tigcat 发表于 2021-8-16 21:08

感谢，就是要这样的效果

lxl217114

要点3次鼠标，感觉意义不大。

Myday

同意楼上，太麻烦，我做的是靠近那一侧，点一下就可以绘制。