求快速画开启线
点取封闭区域，一般都是矩形，快速画开启线到指定图层，2个选项，上悬窗和下悬窗，并有记忆功能，比如上次选的是上悬窗，之后命令就默认为上悬；如图： 漏了子函数(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
) (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)
) start4444 发表于 2021-3-16 13:00
(defun c:tt5 (/ ent key ptlst px)
(setq key (getstring"开口方向？[上开(S)/下开(X)]:"))
( whil ...
多谢大师，但是用不了，出现以下提示：
错误: *error* 函数中出错参数类型错误: lentityp nil start4444 发表于 2021-3-16 14:07
漏了子函数
(defun c:tt5 (/ ent key ptlst px)
这次加载了，没任何反应
麻烦再帮我看下！ start4444 发表于 2021-3-16 14:07
漏了子函数
(defun c:tt5 (/ ent key ptlst px)
恩，可以拉，谢谢！
首次命令默认是下开的，能否调成默认是上开！ start4444 发表于 2021-3-16 14:07
漏了子函数
(defun c:tt5 (/ ent key ptlst px)
厉害了！
如果所选区域不闭合，能否提示呢？
另外，如果作图不规范，像下图这样怎么处理？
本帖最后由 gaics 于 2021-3-17 10:40 编辑
gaics 发表于 2021-3-17 08:38
厉害了！
如果所选区域不闭合，能否提示呢？
另外，如果作图不规范，像下图这样怎么处理？
正如楼主所说，开启窗一般都是矩形，所以我用vla-getboundingbox函数解决了。
cjjh8301 发表于 2021-3-16 18:20
恩，可以拉，谢谢！
首次命令默认是下开的，能否调成默认是上开！
(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)))
)
这个看下 其他的地方帮来的也是明经上
页:
[1]
2