画门开向线

小毛草

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;窗开启方向;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:CBB (/ *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" 443)
        (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)                                       
                                )
                                (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (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)
                                        Ltype (vlax-for each (vla-get-Linetypes (vla-get-activedocument (vlax-get-acad-object))) (setq out (cons (vla-get-Name each) out)))
                                )
                                (if (member "DASH" ltype)
                                        (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 6 "DASH") (cons 90 (length ptlst))) (mapcar '(lambda (x) (cons 10 x)) ptlst)))
                                        (progn
                                                (vla-Load (vla-get-Linetypes (vla-get-ActiveDocument (vlax-get-acad-object))) "DASH" (findfile "acad.lin"))
                                                (entmake (append (list '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 6 "DASH") (cons 90 (length ptlst))) (mapcar '(lambda (x) (cons 10 x)) ptlst)))
                                        )
                                )
                                (setq pt1 (getpoint "\n第一点："))
                        )
                )
        )
  (setvar "OSMODE" os)
        (princ)
)

酷酷提

小毛草 发表于 2021-11-25 08:39
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;窗开启方向;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:CBB (/ *error* ...

老师，请教一下，这个代码会把对象捕捉全部清空，我在代码上面增加了几个备份的命令，怎么还是会清空呢，而且不能备份

2. (defun c:CBB()
   
3. ;; 下一条指令为 备份对象捕捉设置
   
4. (setq old (getvar "OSMODE"))
   
5. ;; 下一条指令为 取消和清空对象捕捉
   
6.   (setvar "osmode" 0)
   
7. (vl-load-com)
   
8. (setq cmd (getvar "cmdecho"))
   
9. (setq osm (getvar "osmode"))
   
10. (setvar "cmdecho" 0)
    
11. (setvar "osmode" 0)
    
12. (command "_undo" "be")
    
13. (while (setq ssa (ssget ":S" '((0 . "LWPOLYLINE"))))
    
14. (setq entx (car (ssnamex ssa)))
    
15. (setq obj  (vlax-ename->vla-object (cadr entx)))
    
16. (setq pae  (vlax-curve-getendparam obj))
    
17. (if (or (and (= pae 4.0) (= (vlax-curve-isClosed obj) t))
    
18. (and (= pae 4.0) (equal (vlax-curve-getstartpoint obj) (vlax-curve- getendpoint obj))))
    
19. (progn
    
20. (setq pt   (cadr (last entx)))
    
21. (setq pt0  (vlax-curve-getclosestpointto obj pt))
    
22. (setq par  (vlax-curve-getparamatpoint obj pt0))
    
23. (setq pai  (fix par))
    
24. (setq pai-1 (- pai 1.0))
    
25. (if (< pai-1 0.0) (setq pai-1 (+ pai-1 pae)))
    
26. (setq pai+1 (+ pai 2.0))
    
27. (if (> pai+1 pae) (setq pai+1 (- pai+1 pae)))
    
28. (setq pmid  (vlax-curve-getpointatparam obj (+ pai 0.5)))
    
29. (setq pt1   (vlax-curve-getpointatparam obj pai-1))
    
30. (setq pt2   (vlax-curve-getpointatparam obj pai+1))
    
31. (command "_pline" pt1 pmid pt2 ""))
    
32. (alert "你所选取的不由4点组成的闭合矩形!")))
    
33. (command "_undo" "e")
    
34. (setvar "osmode" osm)
    
35. (setvar "cmdecho" cmd)
    
36. ;; 下一条指令为 恢复对象捕捉设置
    
37. (setvar "OSMODE" old)
    
38. (princ))

(defun c:CBB()<br /> ;; 下一条指令为 备份对象捕捉设置<br /> (setq old (getvar "OSMODE"))<br /> ;; 下一条指令为 取消和清空对象捕捉<br />   (setvar "osmode" 0)<br /> (vl-load-com)<br /> (setq cmd (getvar "cmdecho"))<br /> (setq osm (getvar "osmode"))<br /> (setvar "cmdecho" 0)<br /> (setvar "osmode" 0)<br /> (command "_undo" "be")<br /> (while (setq ssa (ssget ":S" '((0 . "LWPOLYLINE"))))<br /> (setq entx (car (ssnamex ssa)))<br /> (setq obj  (vlax-ename->vla-object (cadr entx)))<br /> (setq pae  (vlax-curve-getendparam obj))<br /> (if (or (and (= pae 4.0) (= (vlax-curve-isClosed obj) t))<br /> (and (= pae 4.0) (equal (vlax-curve-getstartpoint obj) (vlax-curve- getendpoint obj))))<br /> (progn<br /> (setq pt   (cadr (last entx)))<br /> (setq pt0  (vlax-curve-getclosestpointto obj pt))<br /> (setq par  (vlax-curve-getparamatpoint obj pt0))<br /> (setq pai  (fix par))<br /> (setq pai-1 (- pai 1.0))<br /> (if (< pai-1 0.0) (setq pai-1 (+ pai-1 pae)))<br /> (setq pai+1 (+ pai 2.0))<br /> (if (> pai+1 pae) (setq pai+1 (- pai+1 pae)))<br /> (setq pmid  (vlax-curve-getpointatparam obj (+ pai 0.5)))<br /> (setq pt1   (vlax-curve-getpointatparam obj pai-1))<br /> (setq pt2   (vlax-curve-getpointatparam obj pai+1))<br /> (command "_pline" pt1 pmid pt2 ""))<br /> (alert "你所选取的不由4点组成的闭合矩形!")))<br /> (command "_undo" "e")<br /> (setvar "osmode" osm)<br /> (setvar "cmdecho" cmd)<br /> ;; 下一条指令为 恢复对象捕捉设置<br /> (setvar "OSMODE" old)<br /> (princ))

小毛草

应该不会吧，你增加这个(setvar "cmdecho" 0)
(setvar "osmode" 0)是为什么？

酷酷提

小毛草 发表于 2022-6-7 17:41
应该不会吧，你增加这个(setvar "cmdecho" 0)
(setvar "osmode" 0)是为什么？

就是清空对象捕捉，但是好像和下面重复了，取消了也不行，还是不能备份和恢复

注册

适用度貌似不是太广----