绘制洞开线及门开启方向线求大神修改

00放飞梦想00

(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)

cq4920

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)
                                                        )
    )
  )
  (setq  minx (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
)

cq4920

拾取封闭空间一点A，生产边界线x，识别X定点个数是否为4，如果为真，重新排序顶点，p1p2p3p4，开启正交模式 拾取开启方向的一点B   判断点A到点B的角度值 如果为正或假 连接 p1 （p2和p3中点）p4 如果为负 连接 p2 （p1和p4点中）p3 ，

洞口线 似乎直接选择P1 P2 再给个1/4方向p3就可吧！一共起开方向也就4种！

思路应该差不多就是这样！

你发个截图就好理解了！

huisguiji

cq4920 发表于 2020-3-23 19:47
感觉真的没啥用

主体代码在这了，基本上改一改 可以画很多东西了！比如我帖子里的木工板 壁纸硬包  ...

大佬你好，你这个开启识别是是直线吗，怎么改成只识别矩形呢，你这个现在有2个问题，如果框内有别的线直线就不行，如果有标注就会把标注文字生成一框线

cq4920

诉求不明确，代码又太乱！

00放飞梦想00

cq4920 发表于 2020-3-23 00:24
诉求不明确，代码又太乱！

开门线，鼠标控制开启方向，指定线型
洞口线，鼠标控制开启方向，指定线型

Fqb0515

不能用啊！

00放飞梦想00

就是这个效果，麻烦帮忙看下，谢谢

00放飞梦想00

cq4920 发表于 2020-3-23 17:51
拾取封闭空间一点A，生产边界线x，识别X定点个数是否为4，如果为真，重新排序顶点，p1p2p3p4，开启正交模式 ...

洞口画线，有对话框行式

cq4920

00放飞梦想00 发表于 2020-3-23 19:02
就是这个效果，麻烦帮忙看下，谢谢

两点选矩形范围，确定线形和图层，最后确定方向。个人觉得线形和图层没啥必要哈！毕竟线形和图层其实都是固定的！另外它这个还有预览功能，我是无能为力了！

cq4920

感觉真的没啥用

主体代码在这了，基本上改一改 可以画很多东西了！比如我帖子里的木工板 壁纸硬包 立面图  天花造型 等等
预览功能我肯定是不会！

图层选择 线形选择加点条件就可以实现了！

00放飞梦想00