画门开向线

KO你 · 发表于 2019-7-12 19:11:59

快捷键 rm 画门开向线
(defun c:rm()
(setq v1 (getvar "cmdecho"))
(setq v2 (getvar "blipmode"))
(setq cly (getvar "clayer"))
(setq v4 (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq p1 (getpoint "\n输入矩形门的一个角点："))
(setq p3 (getpoint p1 "\n输入矩形门的另一个角点："))
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq x3 (car p3))
(setq y3 (cadr p3))
(setq p2 (list x3 y1))
(setq p4 (list x1 y3))
(setq x5 (+ x1 (* 0 (- x3 x1))))
(setq y5 (+ y1 (* 0.5 (- y3 y1))))
(setq p5 (list x5 y5))
(setvar "osmode" 0)
(command "pline" p1 p5 p3 "")
(setvar "cmdecho" v1)
(setvar "blipmode" v2)
(setvar "clayer" cly)
(setvar "osmode" v4))

还差一步不知道怎么调整，请教高手帮忙看看

小毛草 · 发表于 2021-11-25 08:39:25

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;窗开启方向;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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)
)

酷酷提 · 发表于 2022-6-7 17:07:04

本帖最后由酷酷提于 2022-6-7 17:08 编辑

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

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

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

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

KO你 · 发表于 2021-11-24 21:15:41

Shing 发表于 2021-11-24 21:11
可以，很不错，用了

可以试用这版，有不同体验哦
快捷键 rm 画门开向线
(defun c:rm()
(vl-load-com)
(setq cmd (getvar "cmdecho"))
(setq osm (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(command "_undo" "be")
(while (setq ssa (ssget ":S" '((0 . "LWPOLYLINE"))))
(setq entx (car (ssnamex ssa)))
(setq obj (vlax-ename->vla-object (cadr entx)))
(setq pae (vlax-curve-getendparam obj))
(if (or (and (= pae 4.0) (= (vlax-curve-isClosed obj) t))
(and (= pae 4.0) (equal (vlax-curve-getstartpoint obj) (vlax-curve- getendpoint obj))))
(progn
(setq pt (cadr (last entx)))
(setq pt0 (vlax-curve-getclosestpointto obj pt))
(setq par (vlax-curve-getparamatpoint obj pt0))
(setq pai (fix par))
(setq pai-1 (- pai 1.0))
(if (< pai-1 0.0) (setq pai-1 (+ pai-1 pae)))
(setq pai+1 (+ pai 2.0))
(if (> pai+1 pae) (setq pai+1 (- pai+1 pae)))
(setq pmid (vlax-curve-getpointatparam obj (+ pai 0.5)))
(setq pt1 (vlax-curve-getpointatparam obj pai-1))
(setq pt2 (vlax-curve-getpointatparam obj pai+1))
(command "_pline" pt1 pmid pt2 ""))
(alert "你所选取的不由4点组成的闭合矩形!")))
(command "_undo" "e")
(setvar "osmode" osm)
(setvar "cmdecho" cmd)
(princ))

迷失2004 · 发表于 2019-7-12 20:09:56

(command "pline" p2 p5 p3 "")
是不是这样？

KO你 · 发表于 2019-7-12 20:42:38

迷失2004 发表于 2019-7-12 20:09
(command "pline" p2 p5 p3 "")
是不是这样？

是的，感谢。

KO你 · 发表于 2019-7-12 20:44:16

试用OK
快捷键 rm 画门开向线
(defun c:rm()
(setq v1 (getvar "cmdecho"))
(setq v2 (getvar "blipmode"))
(setq cly (getvar "clayer"))
(setq v4 (getvar "osmode"))
(setvar "cmdecho" 0)
(setvar "blipmode" 0)
(setq p1 (getpoint "\n输入矩形门的一个角点："))
(setq p3 (getpoint p1 "\n输入矩形门的另一个角点："))
(setq x1 (car p1))
(setq y1 (cadr p1))
(setq x3 (car p3))
(setq y3 (cadr p3))
(setq p2 (list x3 y1))
(setq p4 (list x1 y3))
(setq x5 (+ x1 (* 0 (- x3 x1))))
(setq y5 (+ y1 (* 0.5 (- y3 y1))))
(setq p5 (list x5 y5))
(setvar "osmode" 0)
(command "pline" p2 p5 p3 "")
(setvar "cmdecho" v1)
(setvar "blipmode" v2)
(setvar "clayer" cly)
(setvar "osmode" v4))

alexmai · 发表于 2019-7-16 18:40:02

动态块，搞这个比较方便，也直观，修改也方便

KO你 · 发表于 2019-7-17 16:18:55

alexmai 发表于 2019-7-16 18:40
动态块，搞这个比较方便，也直观，修改也方便

好建议，但有时收到别人的图纸，要修改，其实这个也快捷不了多少

00放飞梦想00 · 发表于 2020-3-23 16:05:39

KO你发表于 2019-7-12 20:44
试用OK
快捷键 rm 画门开向线
(defun c:rm()

如果能加个，鼠标控制开启方向，指定图层和线型就更完美了

00放飞梦想00 · 发表于 2020-3-23 16:06:40

KO你发表于 2019-7-12 20:44
试用OK
快捷键 rm 画门开向线
(defun c:rm()

顶顶顶

Shing · 发表于 2021-11-24 21:11:48

可以，很不错，用了

账号		自动登录	找回密码
密码			注册

[讨论] 画门开向线

本帖子中包含更多资源