社区 › Auto Lisp › Lisp确定

sadhu 发表于 2022-7-6 06:45:53

Lisp确定

我需要列出图纸中参考块前面的块（前列表）和后面的第二个块列表（后列表）。前面的列表需要相对于参考块从左到右（顺时针）排序，而后面的列表必须从右到左（逆时针）排序。
 
参考块是一个矩形，箭头指向正面。当箭头（面）指向下方时，其旋转角度（dxf 50）为零。
 
我曾想过比较参考块和其他块（插入点-dxf 10）的旋转角度（dxf 50）以获得前列表和后列表，但我缺少一些基本的数学/几何和lisp命令。
 
感谢所有需要调查的帮助、想法和想法。

BIGAL 发表于 2022-7-6 07:04:37

张贴一张不确定“在前面”的图片

sadhu 发表于 2022-7-6 07:13:05

这就是我的工作方式。
见附件。
 

(defun C: test(/)
(setq blklst (ssget "X" (list '(0 . "INSERT"))))
(setq numblk (sslength blklst)
   blk_cnt        0)

(while (< blk_cnt numblk)

   (setq en (ssname blklst blk_cnt))
   (setq enlist (entget en))               
   
(cond ((and (= (cdr (assoc 0 enlist)) "INSERT")(= (cdr (assoc 2 enlist)) "ITEMS"))

       "(get ITEMS angle )
       (compare with REF_BLK angle )
      
       [( if   ref_blk_angle + 270° > Item_angle > ref_blk_angle + 90°) then add to back_list]
       [( if   ref_blk_angle + 90° > Item_angle > ref_blk_angle - 90°) then add to front_list]        "

      
      ))


(setq blk_cnt (+ 1 blk_cnt))
))
测试。图纸

David Bethel 发表于 2022-7-6 07:24:47

这可能是一个起点：
 

(defun c:fblst (/ ss rn rd rp sa ea ia i en ed ip an)
(while (not rn)
      (princ "\nSelect Reference INSERT ...")
      (setq ss (ssget '((0 . "INSERT"))))
      (if (= (sslength ss) 1)
            (setq rn (ssname ss 0))))
(setq rd (entget rn)
       rp (cdr (assoc 10 rd))
       sa (cdr (assoc 50 rd))
       ea (+ sa pi)
       ia (if (> sa ea)
            (+ (- (* 2 pi) sa) ea)
            (- ea sa)))

(setq rl (ssadd))
(setq fl (ssadd))

(and (setq ss (ssget "X" '((0 . "INSERT")(2 . "ITEMS"))))
      (setq i 0)
      (while (setq en (ssname ss i))
             (setq i (1+ i)
                  ed (entget en)
                  ip (cdr (assoc 10 ed))
                  an (angle rp ip))
             (if (> sa an)
               (setq an (+ an pi pi)))
             (if (< sa an (+ sa ia))
               (ssadd en rl)
               (ssadd en fl))))
(prin1))

 
 
选取集rl包含“后”的实体，fl包含“前”的实体
 
-大卫

Lee Mac 发表于 2022-7-6 07:31:14

另一个与David的方法非常相似的快速示例：
(defun c:orderblocks ( / 2pi ang blk bot ent inc ins rot sel top )
   (if
       (and
         (princ "\nSelect Reference Block: ")
         (setq blk (ssget "_+.:E:S" '((0 . "INSERT"))))
         (setq sel (ssget "_X"      '((0 . "INSERT") (2 . "ITEMS"))))
       )
       (progn
         (setq blk (entget (ssname blk 0))
               ins (cdr (assoc 10 blk))
               rot (cdr (assoc 50 blk))
               2pi (+ pi pi)
         )
         (repeat (setq inc (sslength sel))
               (setq ent (ssname sel (setq inc (1- inc)))
                     ang (rem (+ 2pi (- (angle ins (cdr (assoc 10 (entget ent)))) rot)) 2pi)
               )
               (if (< 0 ang pi)
                   (setq bot (cons (cons ang ent) bot))
                   (setq top (cons (cons ang ent) top))
               )
         )
         (setq bot (vl-sort bot '(lambda ( a b ) (< (car a) (car b))))
               top (vl-sort top '(lambda ( a b ) (> (car a) (car b))))
         )
         (getstring "\n-- 'Top' blocks --\n<Next>")
         (while top
               (redraw (cdar top) 3)
               (getstring "\n<Next>")
               (redraw (cdar top) 4)
               (setq top (cdr top))
         )
         (getstring "\n-- 'Bottom' blocks --\n<Next>")
         (while bot
               (redraw (cdar bot) 3)
               (getstring "\n<Next>")
               (redraw (cdar bot) 4)
               (setq bot (cdr bot))
         )
       )
   )
   (princ)
)
 
突出显示的部分纯粹是为了显示结果。

sadhu 发表于 2022-7-6 07:44:52

谢谢大卫，谢谢李。这正是我需要的。你们真的很好。
 
李，你的代码也会排序，图形效果很有帮助。再次感谢。

Lee Mac 发表于 2022-7-6 07:55:05

非常欢迎sadhu

查看完整版本: Lisp确定