[求助]：求助lisp修改

huiling6868

哪位能帮助修改以下LISP程序.
单线改双线，支持框选
(defun c:test1 ()
  (CMDLA0)
  (setq        no1 (ureal 1 "" "\n双线宽" no1)
        ss  (ssget (list (cons 0 "LINE")))
        i   -1
  )
  (command ".undo" "BE")
  (setvar "osmode" 0)
  (while (setq s1 (ssname ss (setq i (1+ i))))
    (setq pt1 (dxf 10 (entget s1))
          pt2 (dxf 11 (entget s1))
          pt3 (_midpup pt1 pt2 0.35)
          pt4 (_midpdn pt1 pt2 0.35)
    )
    (command "offset" (/ no1 2) s1 pt3 s1 pt4 "")
    (entdel s1)
  )
  (command ".undo" "E")
  (CMDLA1)
)

;;;双向偏移
(defun c:test2 ()
  (SETQ getds (UDIST 7 "" "\n输入偏移距离<可直接量取>:" getds nil))
  (if (ssget '((0 . "Arc,Circle,Ellipse,*Line")))
    (vlax-for obj (vla-get-activeselectionset
                    (vla-get-activedocument (vlax-get-acad-object))
                  )
      (vla-offset obj getds)
      (vla-offset obj (* getds -1))
    )
    (vlax-release-object obj)
  )
)

1.偏移后线自动到当前层,这样轴线偏移后可以到自已设的墙层.
2.单线改双线偏移后原线是否删除可选.

xyp1964

2. [FONT=courier new](defun c:test1 ()
   
3.   (CMDLA0)
   
4.   (setq        no1 (ureal 1 "" "\n双线宽" no1)
   
5.         TX1 (UKWORD 1 "1 2" "\n原线 : 1-保留/2-删除" TX1)
   
6.         ss  (ssget (list (cons 0 "LINE")))
   
7.         i   -1
   
8.   )
   
9.   (setvar "osmode" 0)
   
10.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
11.     (setq pt1 (dxf 10 (entget s1))
    
12.           pt2 (dxf 11 (entget s1))
    
13.           pt3 (_midpup pt1 pt2 (/ no1 2.0))
    
14.           pt4 (_midpdn pt1 pt2 (/ no1 2.0))
    
15.     )
    
16.     (command "offset" (/ no1 2) s1 pt3 s1 pt4 "")
    
17.     (if        (= TX1 "2")
    
18.       (entdel s1)
    
19.     )
    
20.   )
    
21.   (CMDLA1)
    
22. )[/FONT]

[FONT=courier new](defun c:test1 ()<br />   (CMDLA0)<br />   (setq        no1 (ureal 1 "" "\n双线宽" no1)<br />         TX1 (UKWORD 1 "1 2" "\n原线 : 1-保留/2-删除" TX1)<br />         ss  (ssget (list (cons 0 "LINE")))<br />         i   -1<br />   )<br />   (setvar "osmode" 0)<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq pt1 (dxf 10 (entget s1))<br />           pt2 (dxf 11 (entget s1))<br />           pt3 (_midpup pt1 pt2 (/ no1 2.0))<br />           pt4 (_midpdn pt1 pt2 (/ no1 2.0))<br />     )<br />     (command "offset" (/ no1 2) s1 pt3 s1 pt4 "")<br />     (if        (= TX1 "2")<br />       (entdel s1)<br />     )<br />   )<br />   (CMDLA1)<br /> )[/FONT]

huiling6868

谢谢斑竹,能否再完善一下,能偏移到当前层.

xyp1964

2. [FONT=courier new](defun c:test1 ()
   
3.   (CMDLA0)
   
4.   (setq        no1 (ureal 1 "" "\n双线宽" no1)
   
5.         TX1 (UKWORD 1 "1 2" "\n原线 : 1-保留/2-删除" TX1)
   
6.         ss  (ssget (list (cons 0 "LINE")))
   
7.         i   -1
   
8.   )
   
9.   (setvar "osmode" 0)
   
10.   (while (setq s1 (ssname ss (setq i (1+ i))))
    
11.     (setq pt1 (dxf 10 (entget s1))
    
12.           pt2 (dxf 11 (entget s1))
    
13.           pt3 (_midpup pt1 pt2 (/ no1 2.0))
    
14.           pt4 (_midpdn pt1 pt2 (/ no1 2.0))
    
15.     )
    
16.     (command "offset" (/ no1 2) s1 pt3  "")
    
17.     (command"change" (entlast) "" "p""la"(getvar"clayer")"")
    
18.     (command "offset" (/ no1 2) s1 pt4 "")
    
19.     (command"change" (entlast) "" "p""la"(getvar"clayer")"")
    
20.     (if        (= TX1 "2")
    
21.       (entdel s1)
    
22.     )
    
23.   )
    
24.   (CMDLA1)
    
25. )[/FONT]

[FONT=courier new](defun c:test1 ()<br />   (CMDLA0)<br />   (setq        no1 (ureal 1 "" "\n双线宽" no1)<br />         TX1 (UKWORD 1 "1 2" "\n原线 : 1-保留/2-删除" TX1)<br />         ss  (ssget (list (cons 0 "LINE")))<br />         i   -1<br />   )<br />   (setvar "osmode" 0)<br />   (while (setq s1 (ssname ss (setq i (1+ i))))<br />     (setq pt1 (dxf 10 (entget s1))<br />           pt2 (dxf 11 (entget s1))<br />           pt3 (_midpup pt1 pt2 (/ no1 2.0))<br />           pt4 (_midpdn pt1 pt2 (/ no1 2.0))<br />     )<br />     (command "offset" (/ no1 2) s1 pt3  "")<br />     (command"change" (entlast) "" "p""la"(getvar"clayer")"")<br />     (command "offset" (/ no1 2) s1 pt4 "")<br />     (command"change" (entlast) "" "p""la"(getvar"clayer")"")<br />     (if        (= TX1 "2")<br />       (entdel s1)<br />     )<br />   )<br />   (CMDLA1)<br /> )[/FONT]

huiling6868

谢谢,收下了.