绘制洞开线及门开启方向线求大神修改
(defun c:dk (/ p1)(while (setq p1 (getpoint "\n点取封闭区域内部一点:<限制为四条边> ")) (lxf:dkline p1))
)
(defun c:dkk (/ p1 dkkfx)
(initget "L R U D")
(setq dkkfx (getkword "\n 输入开启方向Left/Right/Up/Down<L,R,U,D>: <Left> "))
(if (= dkkfx nil) (setq dkkfx "L")) (setq dkkfx (strcase dkkfx)) (while (setq p1 (getpoint "\n点取封闭区域内部一点:<限制为四条边> "))
(lxf:dkkline p1 dkkfx)))
;-----------------------------------------------------------------(defun lxf:dkline (p1 / oldosm ss new_list pt_1 pt_2 pt_3 pt_4 pt_13distance p0 n ptt pts ss1 no-1 ) (setvar "cmdecho" 0) (setq oldosm (getvar "osmode"))(setvar "osmode" 0) (command "boundary" "A" "I" "N" "N" "" p1 "") (setq ss (entlast));边界失败会选择上次 (lxf_lisp-ptn ss 10) (if (/= (length new_list) 4) (progn (setvar "osmode" oldosm) (princ "\n请选择封闭的四边内部空间：") (princ (strcat "注意：图形节点数量" (rtos (length new_list) 2)))(princ) (exit) )) (setq pt_1 (nth 1 new_list)) (setq pt_2 (nth 2 new_list)) (setq pt_3 (nth 3 new_list)) (setq pt_4 (nth 0 new_list)) (setq pt_13distance (distance pt_2 pt_4)) (setq p0 (polar pt_2 (angle pt_2 pt_4) (* pt_13distance 0.2))) (setq n (length new_list)) (while (/= n 0) (setq ptt (nth (- n 1) new_list)) (command "line" p1 ptt "") (setq ss1 (entlast)) (setq no-1 (length (sl-Curveinters ss1 ss))) (if(= no-1 2) (progn(command "erase" ss1 "")(setvar "osmode" oldosm)(exit) ) (command "erase" ss1 "") ) (setq n (1- n))) (command "erase" ss "") (command "pline" pt_1 p0 pt_3 "") (command "CHANGE" (entlast) "" "P" "C" 2 "lt" "ACAD_ISO02W100" "" ) (setvar "osmode" oldosm) (princ));---------------------------------------------------------(defun lxf:dkkline (p1 dkkfx / oldosmss new_list pt_1 pt_2 pt_3 pt_4n ptt pts ss1 no-1 p0 ) (setvar "cmdecho" 0) (setq oldosm (getvar "osmode"))(setvar "osmode" 0) (command "boundary" "A" "I" "N" "N" "" p1 "") (setq ss (entlast));边界失败会选择上次 (lxf_lisp-ptn ss 10) (if (/= (length new_list) 4) (progn (setvar "osmode" oldosm) (princ "\n请选择封闭的四边内部空间：") (princ (strcat "注意：图形节点数量" (rtos (length new_list) 2)))(princ) (exit) )) (setq pt_1 (nth 1 new_list)) (setq pt_2 (nth 2 new_list)) (setq pt_3 (nth 3 new_list)) (setq pt_4 (nth 0 new_list)) (cond ((= dkkfx "L") (setq p0 (mapcar '(lambda (x y) (* (+ x y) 0.5)) pt_1 pt_2)) ) ((= dkkfx "R") (setq p0 (mapcar '(lambda (x y) (* (+ x y) 0.5)) pt_3 pt_4)) ) ((= dkkfx "U") (setq p0 (mapcar '(lambda (x y) (* (+ x y) 0.5)) pt_2 pt_3)) ) ((= dkkfx "D") (setq p0 (mapcar '(lambda (x y) (* (+ x y) 0.5)) pt_1 pt_4)) ) (T (setq p0 (mapcar '(lambda (x y) (* (+ x y) 0.5)) pt_1 pt_2)) )) (setq n (length new_list)) (while (/= n 0) (setq ptt (nth (- n 1) new_list)) (command "line" p1 ptt "") (setq ss1 (entlast)) (setq no-1 (length (sl-Curveinters ss1 ss))) (if(= no-1 2) (progn(command "erase" ss1 "")(setvar "osmode" oldosm)(exit) ) (command "erase" ss1 "") ) (setq n (1- n))) (command "erase" ss "") (cond ((= dkkfx "L") (command "pline" pt_3 p0 pt_4 "")) ((= dkkfx "R") (command "pline" pt_1 p0 pt_2 "")) ((= dkkfx "U") (command "pline" pt_1 p0 pt_4 "")) ((= dkkfx "D") (command "pline" pt_2 p0 pt_3 "")) (T (command "pline" pt_3 p0 pt_4 "")) ) (command "CHANGE" (entlast) "" "P" "C" 2 "lt" "ACAD_ISO02W100" "" ) (setvar "osmode" oldosm) (princ))(princ)
huisguiji 发表于 2023-4-11 13:57
大佬你好，你这个开启识别是是直线吗，怎么改成只识别矩形呢，你这个现在有2个问题，如果框内有别的线直 ...
(setq ent (entlast))
(vl-cmdf "_BOUNDARY" (getpoint) "")
(setq ss (last_ent ent))
(repeat (setq n (sslength ss))
(setq obj (vlax-ename->vla-object (ssname ss (setq n (1- n)))))
(vla-getboundingbox obj 'x 'y)
(setq lst (cons (vlax-safearray->list y)
(cons (vlax-safearray->list x) lst)
)
)
)
(setqminx (car (vl-sort (mapcar 'car lst) '<))
miny (car (vl-sort (mapcar 'cadr lst) '<))
maxx (car (vl-sort (mapcar 'car lst) '>))
maxy (car (vl-sort (mapcar 'cadr lst) '>))
)
(setq pt1 (list minx miny))
(setq pt2 (list maxx miny))
(setq pt3 (list maxx maxy))
(setq pt4 (list minx maxy))
(vl-cmdf "ERASE" ss"")
这样处理，就不限制内空是不是矩形有没有文字或者是其他的标注
;;40最后生产出的图元
(defun last_ent (en / ss)
(if en
(progn
(setq ss (ssadd))
(while (setq en (entnext en))
(if (not (member (cdr (assoc 0 (entget en)))
'("ATTRIB" "VERTEX" "SEQEND")
)
)
(ssadd en ss)
);if
);while
(if (zerop (sslength ss)) (setq ss nil))
ss
);progn
(ssget "_x")
);if
)
拾取封闭空间一点A，生产边界线x，识别X定点个数是否为4，如果为真，重新排序顶点，p1p2p3p4，开启正交模式 拾取开启方向的一点B 判断点A到点B的角度值 如果为正或假 连接 p1 （p2和p3中点）p4 如果为负 连接 p2 （p1和p4点中）p3 ，
洞口线 似乎直接选择P1 P2 再给个1/4方向p3就可吧！一共起开方向也就4种！
思路应该差不多就是这样！
你发个截图就好理解了！ cq4920 发表于 2020-3-23 19:47
感觉真的没啥用
主体代码在这了，基本上改一改 可以画很多东西了！比如我帖子里的木工板 壁纸硬包...
大佬你好，你这个开启识别是是直线吗，怎么改成只识别矩形呢，你这个现在有2个问题，如果框内有别的线直线就不行，如果有标注就会把标注文字生成一框线 诉求不明确，代码又太乱！ cq4920 发表于 2020-3-23 00:24
诉求不明确，代码又太乱！
开门线，鼠标控制开启方向，指定线型
洞口线，鼠标控制开启方向，指定线型 不能用啊！ 就是这个效果，麻烦帮忙看下，谢谢
cq4920 发表于 2020-3-23 17:51
拾取封闭空间一点A，生产边界线x，识别X定点个数是否为4，如果为真，重新排序顶点，p1p2p3p4，开启正交模式 ...
洞口画线，有对话框行式
00放飞梦想00 发表于 2020-3-23 19:02
就是这个效果，麻烦帮忙看下，谢谢
两点选矩形范围，确定线形和图层，最后确定方向。个人觉得线形和图层没啥必要哈！毕竟线形和图层其实都是固定的！另外它这个还有预览功能，我是无能为力了！ 本帖最后由 cq4920 于 2020-3-23 19:58 编辑
感觉真的没啥用
主体代码在这了，基本上改一改 可以画很多东西了！比如我帖子里的木工板 壁纸硬包 立面图天花造型 等等
预览功能我肯定是不会！
图层选择 线形选择加点条件就可以实现了！
页:
[1]
2