这个双向偏移代码，如何实现循环选择对像，谢谢

depgfdepgf

(defun c:tt1 (/ ss)  
            ;(while ;加入这个循环为何不起作用

•    (if (not dist) (setq dist 240))
•        (setq newdist dist)
•        (princ (strcat "\n当前偏移距离:" (rtos dist) " <空格或者回车设置新距离>"))
•        (while (= ss nil)
•        (setq ss (ssget ":s"))
•        (if (= ss nil)
•        (progn
•        (setq newdist (getdist (strcat "\n设置新距离：" "<" (rtos dist) ">")))
•        (if (= nil newdist)(setq newdist dist)(setq dist newdist))
•          )
•         )
•        )
•        (if (and newdist ss)
•        (vlax-for ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
•        (mapcar '(lambda (x)  (vla-offset ss x))(list newdist (- newdist)))
•        )
•        )
  

           ;);while

• (princ)
• )
  

tigcat

1. ;;双向偏移 SNSJ 2004.3.8
   
2. (defun c:OffsetBoth (/ getds obj lynm ptlay)
   
3.   (defun ptlay (x y)
   
4.     (foreach obj (vlax-safearray->list (vlax-variant-value x))
   
5.       (vla-put-layer obj y)
   
6.     )
   
7.   )
   
8.   (setq        getds
   
9.          (getdist
   
10.            (strcat "\n输入偏移距离<" (rtos (getvar "offsetdist")) ">:")
    
11.          )
    
12.   )
    
13.   (or getds (setq getds (getvar "offsetdist")))
    
14.   (setvar "offsetdist" getds)
    
15.   (setq lynm (getvar "clayer"))
    
16.   (while (ssget ":S" '((0 . "Arc,Circle,Ellipse,*Line")))
    
17.     (vlax-for obj (vla-get-activeselectionset *doc*)
    
18.       (ptlay (vla-offset obj getds) lynm)
    
19.       (ptlay (vla-offset obj (* getds -1)) lynm)
    
20.       (vlax-release-object obj)
    
21.     )
    
22.   )
    
23.   (princ)
    
24. )

;;双向偏移 SNSJ 2004.3.8<br /> (defun c:OffsetBoth (/ getds obj lynm ptlay)<br />   (defun ptlay (x y)<br />     (foreach obj (vlax-safearray->list (vlax-variant-value x))<br />       (vla-put-layer obj y)<br />     )<br />   )<br />   (setq        getds<br />          (getdist<br />            (strcat "\n输入偏移距离<" (rtos (getvar "offsetdist")) ">:")<br />          )<br />   )<br />   (or getds (setq getds (getvar "offsetdist")))<br />   (setvar "offsetdist" getds)<br />   (setq lynm (getvar "clayer"))<br />   (while (ssget ":S" '((0 . "Arc,Circle,Ellipse,*Line")))<br />     (vlax-for obj (vla-get-activeselectionset *doc*)<br />       (ptlay (vla-offset obj getds) lynm)<br />       (ptlay (vla-offset obj (* getds -1)) lynm)<br />       (vlax-release-object obj)<br />     )<br />   )<br />   (princ)<br /> )

技术工作室

;(while ;加入这个循环为何不起作用
(while (= ss nil)
---------------
）;while
;);while
好像是镶套循环的问题，我也遇到相同的问题，也想知道原因并解决问题，不知哪位大能解答一下，谢谢！

xj6019

试试这样
(defun c:NM (/ ss)  
        (if (not dist) (setq dist 240))
        (setq newdist dist)
        (princ (strcat "\n当前偏移距离:" (rtos dist) " <空格或者回车设置新距离>"))
        (while
                (or
                        (setq ss (ssget ":s"))
                        (if (= ss nil)
                                (progn
                                        (setq newdist (getdist (strcat "\n设置新距离：" "<" (rtos dist) ">")))
                                        (if (= nil newdist)(setq newdist dist)(setq dist newdist))
                                )
                        )       
                )       
                (if (= ss nil)
                        (progn
                                (setq ss (ssget ":s"))
                                (if (and newdist ss)
                                        (vlax-for ss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
                                                (mapcar '(lambda (x)  (vla-offset ss x))(list newdist (- newdist)))
                                        )
                                )
                        )
                )
        )
        (princ)
)

mashanjie

tigcat 发表于 2023-8-31 22:30

CAD提示错误哦

mashanjie

xj6019 发表于 2023-9-1 07:39
试试这样
(defun c:NM (/ ss)  
        (if (not dist) (setq dist 240))

能否设置成鼠标右键结束？现在得按ESC