社区 › Auto Lisp › 按名称和rota选择块

handasa 发表于 2022-7-5 17:02:04

按名称和rota选择块

大家好，
我有一个lisp，它按旋转角度选择块，但它选择所有具有相同旋转角度的块实例。我需要过滤结果，以仅选择选定的块实例。。任何帮助都将不胜感激。。。提前感谢
(defun C:SSR ( / s1 i e l f o n s2)
(princ "\nSelect source object:")
(if
   (if
   (setq s1 (ssget "I" '((0 . "INSERT"))))
   (progn (sssetfirst nil nil) s1)
   (setq s1 (ssget '((0 . "INSERT"))))
   )
   (progn
   (repeat (setq i (sslength s1))
       (setq i (1- i)
             o (vlax-ename->vla-object (ssname s1 i))
             e (entget (ssname s1 i))
             l (mapcar '(lambda (a b) (cond ((assoc a e)) (b))) '(0 8 6 62) '(0 0 (6 . "ByLayer") (62 . 256)))
             n (cons (vlax-get o (if (vlax-property-available-p o 'EffectiveName) 'rotation 'EffectiveName)) n)
             )
       (if (not (member l f)) (setq f (cons l f)))
       )
   (setq f (mapcar '(lambda (a) (append '((-4 . "<AND")) a '((-4 . "AND>")))) f))
   (setq f (append '((-4 . "<OR")) (apply 'append f) '((-4 . "OR>"))))
   (princ "\n\nSelect area for similar blocks...")
   (if (setq s2 (ssget f))
       (repeat (setq i (sslength s2))
         (if
         (not (member (vlax-get (setq o (vlax-ename->vla-object (setq e (ssname s2 (setq i (1- i)))))) (if (vlax-property-available-p o 'EffectiveName) 'rotation 'EffectiveName)) n))
         (ssdel e s2)
         )
         )
       )
   (if s2 (princ (strcat (itoa (sslength s2)) " objects")))
   (sssetfirst nil s2)
   )
   )
(if (zerop (getvar 'cmdactive)) (princ) s2)
)

Grrr 发表于 2022-7-5 17:07:04

提到作者的名字是一种很好的方式。

handasa 发表于 2022-7-5 17:09:41

 
是的，如果你知道作者的名字，这是很好的方式。。。但我不知道，因为我有250个lisp文件，我从几年前使用，我不知道我在哪里找到他们。。。

Stefan BMR 发表于 2022-7-5 17:14:17

没关系，Grrr。这是我的错，我的Lisp程序。
 
@handasa：
我猜您使用的是不同的lisp，它通过旋转选择所有块。您发布的lisp正在按名称选择块。这是如何通过旋转将其修改为过滤块。
'(0 8 6 50 62) '(0 0 (6 . "ByLayer") (50 . 0.0) (62 . 256)))

Roy_043 发表于 2022-7-5 17:19:37

这令人难以置信：
(if (vlax-property-available-p o 'EffectiveName) 'rotation 'EffectiveName)

Grrr 发表于 2022-7-5 17:21:14

这是一个很好的代码，斯特凡！这就是为什么我认为作者应该得到一些赞赏。

Stefan BMR 发表于 2022-7-5 17:26:13

没有看到。我在原始代码中进行了更改和测试。

Grrr 发表于 2022-7-5 17:30:57

一些替代方案：
(defun C:test ; Written by: Grrr, credits to: Lee Mac, Tharwat
( / PropsLst SS sBe sBo srcLst i dBe dBo dstLst )

(setq PropsLst (list 'EffectiveName 'Layer 'Linetype 'Rotation 'TrueColor)) ; <- list of required properties

(and (setq SS (ssget "_I" (list (cons 0 "INSERT")))) (sssetfirst nil nil))
(setvar 'errno 0)
(while (/= 52 (getvar 'errno))
        (setq sBe (car (entsel "\nSelect source block:" )))
        (cond
                ( (and sBe (eq (vla-get-ObjectName (setq sBo (vlax-ename->vla-object sBe))) "AcDbBlockReference"))
                        (setq srcLst
                                (mapcar
                                        (function
                                                (lambda (x)
                                                        (if (not (eq x 'TrueColor))
                                                                (vlax-get sBo x)
                                                                (mapcar
                                                                        (function
                                                                                (lambda (p)
                                                                                        (vlax-get (vlax-get sBo 'TrueColor) p)
                                                                                )
                                                                        )
                                                                        (list 'ColorIndex 'Red 'Green 'Blue)
                                                                )
                                                        ); if
                                                )
                                        )
                                        PropsLst
                                )
                        )
                        (setvar 'errno 52)
                )
                ( T nil )
        )
)

(if
        (and
                sBe
                (or SS
                        (and
                                (princ "\nSelect blocks to be filtered: ")
                                (setq SS
                                        (ssget
                                                (vl-remove nil
                                                        (list
                                                                (cons 0 "INSERT")
                                                                (if (member 'EffectiveName PropsLst) (cons 2 (strcat "`*U*," (vla-get-EffectiveName sBo))))
                                                        )
                                                )
                                        )
                                )
                        )
                )
        )
        (repeat (setq i (sslength SS))
                (setq dBo (vlax-ename->vla-object (setq dBe (ssname SS (setq i (1- i))))))
                (setq dstLst
                        (mapcar
                                (function
                                        (lambda (x)
                                                (if (not (eq x 'TrueColor))
                                                        (vlax-get dBo x)
                                                        (mapcar
                                                                (function
                                                                        (lambda (p)
                                                                                (vlax-get (vlax-get dBo 'TrueColor) p)
                                                                        )
                                                                )
                                                                (list 'ColorIndex 'Red 'Green 'Blue)
                                                                )
                                                        ); if
                                                )
                                )
                                PropsLst
                        )
                )
                (and (not (equal srcLst dstLst)) (ssdel dBe SS))
        )
)
(sssetfirst nil SS)
(princ)
);| defun |; (or vlax-get-acad-object (vl-load-com)) (princ)
但不支持多个源块引用。

handasa 发表于 2022-7-5 17:34:43

@Grrr
@斯特凡BMR
非常感谢你们和你们的宝贵贡献。。。你的两个建议都很有效
 
再次感谢

handasa 发表于 2022-7-5 17:36:43

 
这是你原来的lisp，但我对它做了一些不专业的修改，通过旋转选择块。。。在您上次编辑后，它现在可以正常工作。。。再次感谢

查看完整版本: 按名称和rota选择块