求快速画开启线

cjjh8301 · 发表于 2021-3-16 11:46:10

点取封闭区域，一般都是矩形，快速画开启线到指定图层，2个选项，上悬窗和下悬窗，并有记忆功能，比如上次选的是上悬窗，之后命令就默认为上悬；如图：

start4444 · 发表于 2021-3-16 11:46:11

漏了子函数

(defun c:tt5 (/ ent key ptlst px)
(setq key (getstring "开口方向？[上开(S)/下开(X)]:"))
( while (setq px (getpoint "\n选点："))
(command "BOUNDARY" px "")
(setq ent (entlast) ptlst (Dptlst ent) )
(entdel ent)
(if (= key "s") (command "PLINE" "non" (car ptlst) "non" (mid_pt (caddr ptlst) (cadddr ptlst)) "non" (cadr ptlst) "" "change" "l" "" "p" "la" "开启" "")
(command "PLINE" "non" (caddr ptlst) "non" (mid_pt (car ptlst) (cadr ptlst)) "non" (cadddr ptlst) "" "change" "l" "" "p" "la" "开启" "")
)
)
(princ)
)

(defun mid_pt (p1 p2)
(mapcar'*(mapcar'+ p1 p2)'(0.5 0.5 0.5))
)
(defun Dptlst (enn / ent lst)
(setq ent (entget enn))
(setq lst (list))
(foreach x ent (if (= (car x) 10) (setq lst (cons (cdr x) lst))))
lst
)

start4444 · 发表于 2021-3-16 13:00:10

(defun c:tt5 (/ ent key ptlst px)
(setq key (getstring "开口方向？[上开(S)/下开(X)]:"))
( while (setq px (getpoint "\n选点："))
(command "BOUNDARY" px "")
(setq ent (entlast) ptlst (Dptlst ent) )
(entdel ent)
(if (= key "s") (command "PLINE" "non" (car ptlst) "non" (mid_pt (caddr ptlst) (cadddr ptlst)) "non" (cadr ptlst) "" "change" "l" "" "p" "la" "开启" "")
(command "PLINE" "non" (caddr ptlst) "non" (mid_pt (car ptlst) (cadr ptlst)) "non" (cadddr ptlst) "" "change" "l" "" "p" "la" "开启" "")
)
)
(princ)
)

cjjh8301 · 发表于 2021-3-16 13:07:04

start4444 发表于 2021-3-16 13:00
(defun c:tt5 (/ ent key ptlst px)
(setq key (getstring "开口方向？[上开(S)/下开(X)]:"))
( whil ...

多谢大师，但是用不了，出现以下提示：
错误: *error* 函数中出错参数类型错误: lentityp nil

cjjh8301 · 发表于 2021-3-16 14:28:17

start4444 发表于 2021-3-16 14:07
漏了子函数

(defun c:tt5 (/ ent key ptlst px)

这次加载了，没任何反应

麻烦再帮我看下！

cjjh8301 · 发表于 2021-3-16 18:20:41

start4444 发表于 2021-3-16 14:07
漏了子函数

(defun c:tt5 (/ ent key ptlst px)

恩，可以拉，谢谢！
首次命令默认是下开的，能否调成默认是上开！

gaics · 发表于 2021-3-17 08:38:43

start4444 发表于 2021-3-16 14:07
漏了子函数

(defun c:tt5 (/ ent key ptlst px)

厉害了！
如果所选区域不闭合，能否提示呢？
另外，如果作图不规范，像下图这样怎么处理？

gaics · 发表于 2021-3-17 10:37:51

本帖最后由 gaics 于 2021-3-17 10:40 编辑

gaics 发表于 2021-3-17 08:38
厉害了！
如果所选区域不闭合，能否提示呢？
另外，如果作图不规范，像下图这样怎么处理？

正如楼主所说，开启窗一般都是矩形，所以我用vla-getboundingbox函数解决了。

cjjh8301 · 发表于 2021-3-17 11:50:28

cjjh8301 发表于 2021-3-16 18:20
恩，可以拉，谢谢！
首次命令默认是下开的，能否调成默认是上开！

stonedesign · 发表于 2021-10-24 14:55:21

(defun c:tt ()
(setq orth (getvar "orthomode"))
(setq pta (getpoint "\n门洞位置"))
(COMMAND "-BOUNDARY" pta "")
(setvar "orthomode" 1)
(setq ent (entlast))
(setq ss (mapcar 'cdr (vl-remove-if-not '(lambda (x) (= (car x) 10)) (entget ent))))
(if (= (length ss) 4)
(progn
(vl-load-com)
(vla-getboundingbox (vlax-ename->vla-object ent) 'minpoint 'maxpoint)
(setq pmax (vlax-safearray->list maxpoint)
pmin (vlax-safearray->list minpoint))
(setq pt2 (list (car pmax) (cadr pmin)))
(setq pt4 (list (car pmin) (cadr pmax)))
)

)
(COMMAND "_.erase"  ENT "")
(setq ptb (getpoint pta "\n开启方向"))
(setq fx (angle pta ptb))
(if (= fx 0)
(progn
(setq ptc (Mc:Md pmin pt4))
(entmake (list
   '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 2)'(70 . 0) (cons 10 pmax) (cons 10 ptc) (cons 10 pt2)))
)
(progn
(setq ptc (Mc:Md pmax pt2))
(entmake (list
   '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") (cons 90 2)'(70 . 0) (cons 10 pmin) (cons 10 ptc) (cons 10 pt4)))
)
)

(xjtc);检查图层名称
(c:jzxx);检查线形名称
(command "CHPROP" (last_ent ent) "" "la"  "W-虚线" "lt" "DASH" "C" "136"  "s" "1" "")
(setvar "orthomode" orth)
(princ)

)

(defun Mc:Md (pt1 pt2 / ptn)
(setq jl (distance pt1 pt2))
(setq fx (angle pt1 pt2))
(setq ptn (polar pt1 fx (/ jl 2)))
)
这个看下其他的地方帮来的  也是明经上

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

[提问] 求快速画开启线

最佳答案

点评

点评

本帖子中包含更多资源

点评

本帖子中包含更多资源