插件修改

l982414603 发表于 2021-8-15 08:40:37

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

tigcat 发表于 2021-8-15 15:27:29

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 发表于 2021-8-16 21:08:27

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

;202108162107修改
(defun c:kc (/ *error* ang l1 ltype mpt1 os out pt1 pt2 pt3 ptlst os1)
(defun *error* (msg)
(if (not (wcmatch (strcase msg t) "*break,*cancel*,*exit*"))
   (progn
   (setvar "OSMODE" os)
   (setvar "PLINEWID" os1)
   )
)
(princ)
)
;;;;;;----------------------------------------------------
(setq os (getvar "OSMODE"))
(setq os1 (getvar "plinewid"))
(setvar "OSMODE" 1025)
;;; (setvar "plinewid" 0.09)
;;; (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 43 0.09)
      (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 43 0.09)
(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)
(SETVAR "plinewid" os1)
(princ)
)
(prompt "\n******程序运行命令<kc>******")
(prin1)

tigcat 发表于 2021-8-15 14:45:28

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

tigcat 发表于 2021-8-15 19:50:30

另外来一个简单版,没加入循环处理,局部变量,出错处理,线型若不存在也没有加载行为.楼主自行更改下.(defun c:tt ()
(setvar "cmdecho" 0)
(setq oldos (getvar 'osmode))
(setvar 'osmode 0)
(princ "\n选择画框的多段线(仅研究4条边4个顶点的情况):")
(setq en (entsel))
(setq pt (cadr en))
(setq ptm (osnap pt "mid"))
;;;(setq en (ssname (ssget ":s:e" '((0 . "LWPOLYLINE"))) 0))
(setq en_data (entget (car en)))
(setq ptv nil)
(foreach x en_data
(if(= (car x) 10)
   (setq ptv (cons (cdr x) ptv))
)
)
(setq vt1 (nth 0 ptv))
(setq vt2 (nth 1 ptv))
(setq vt3 (nth 2 ptv))
(setq vt4 (nth 3 ptv))
(cond ( (equal (angle ptm vt4) (angle vt3 vt4) 1e-5)
(setq ptj1 vt1)
(setq ptj2 vt2)
)
( (equal (angle ptm vt2) (angle vt1 vt2) 1e-5)
(setq ptj1 vt3)
(setq ptj2 vt4)
)
      ( (equal (angle ptm vt3) (angle vt2 vt3) 1e-5)
(setq ptj1 vt4)
(setq ptj2 vt1)
)
( (equal (angle ptm vt1) (angle vt4 vt1) 1e-5)
(setq ptj1 vt2)
(setq ptj2 vt3)
)
) ;|end cond|;
(setq ptlst (list ptj1 ptm ptj2))
(entmake (append
(list '(0 . "LWPOLYLINE")
      '(100 . "AcDbEntity")
      '(100 . "AcDbPolyline")
      (cons 6 "dash")
      (cons 62 6)
      (cons 90 (length ptlst))
)
(mapcar '(lambda (x) (cons 10 x)) ptlst)
      )
   )
;;;(c:tt)
(prin1)
)

tigcat 发表于 2021-8-15 19:58:40

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

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

l982414603 发表于 2021-8-16 08:11:45

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 发表于 2021-8-17 08:52:09

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

感谢:hug:，就是要这样的效果

lxl217114 发表于 2021-8-17 09:43:07

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

Myday 发表于 2021-8-17 09:47:17

本帖最后由 Myday 于 2021-8-17 09:49 编辑

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

页: [1] 2

明经CAD社区's Archiver

插件修改