一次偏移多条线的代码可以简化吗 最好能列表输入数值

xmq1103

start4444 发表于 2020-9-2 10:29
不对称的双向偏移是比较麻烦的事情，建议你选取两点重复两次单向偏移，这样代码就简单很多了

用您的两个函数拼了一下，您看看有还有更好的写法吗：
(defun c:tt5(/ l lst p)  
  (setq l(entsel"请选择偏移的基线："))
  (setq p (getpoint "点取偏移方向："))
  (setq lst '(5 10 15 20))         ;第一个函数！  
        (pianyi l p lst)
(setq lst '(18 22 6 14))         ;第二个函数！  
        (pianyi-2 l p lst)
        (princ)      
  )

(defun pianyi (ent pt lst / d);间隔数值列表偏移子函数
        (setq d 0)
        (foreach x lst
        (setq d (+ d x))
        (command "offset" d ent pt "")
        )      
)


(defun pianyi-2 (ent pt lst / d);间隔数值列表双向偏移子函数
  (vl-load-com)
        (setq d 0)
        (setq obj (vlax-ename->vla-object (car ent)))
        (foreach x lst
        (setq d (+ d x))                     
      ;这里去掉一句
        (vla-Offset obj (* -1 d))      
        )      
)

xmq1103

xmq1103 发表于 2020-9-2 10:37
用您的两个函数拼了一下，您看看有还有更好的写法吗：
(defun c:tt5(/ l lst p)  
  (setq l(entsel"请 ...

如果不用VL函数，能定义个反向偏移的子函数吗。你说的两点，是说偏移两次吗，偏移两次麻烦吧。
如果可以的话，用你的第一个函数怎么改成反向偏移。

我这样改了改，但是不能执行呢，求指教：
(defun pianyi (ent pt lst / d);间隔数值列表偏移子函数
        (setq d 0)
        (foreach x lst
        (setq d (* -1 (+ d x)))
        (command "offset" d ent pt "")
        )      
)

start4444

反向的函数关键找到偏移方向点，你能把反向的方向点给计算出来就行，根据正向点来计算反向点，想想都头疼

(defun c:tt5(/ l lst lst2 p p2)  
  (setq l(entsel"请选择偏移的基线："))
  (setq p (getpoint "点取偏移正方向：") p2 (getpoint "点取偏移反方向："))
  (setq lst '(2 16 2 12));正向
        (setq lst2 '(18 22 6 14));反向
        (pianyi l p lst)
        (pianyi l p2 lst2)
        (princ)       
  )

xmq1103

start4444 发表于 2020-9-2 11:16
反向的函数关键找到偏移方向点，你能把反向的方向点给计算出来就行，根据正向点来计算反向点，想想都头疼
...

谢谢，有时间的话，看看这个函数能从里面找出点能利用的函数不，给您添麻烦了，谢谢我看不太懂，哪部分能提取出来当反向函数。
*******************
;;;批量偏移
;;;ago9999,梨胡鸟编写(QQ17137646)
(defun c:py (/ en offd pt py_fs offd dx_ss dx_ss dx_n pt pt0 n)
  (command "undo" "be")                        ; 定义返回点
  (setvar "cmdecho" 0)                        ; 关闭命令提示

  (if (or (= py_fs0 nil) (eq py_fs0 ""))
    (setq py_fs0 "Z")
  )
  (princ "\n请输入偏移方式[正向(Z)/反向(F)/双向(S)/通过(T)]<")
  (princ py_fs0)                        ;输入偏移方式
  (princ ">:")
  (setq py_fs (getstring))
  (if (or (= py_fs nil) (eq py_fs ""))
    (setq py_fs py_fs0)
    (setq py_fs0 py_fs)
  )

  (if (or (eq py_fs "t") (eq py_fs "T"))
    (princ "\n采用通过点偏移方式")
    (progn
      (if (= offd0 nil)
        (setq offd0 "0")
      )
      (princ "\n请输入偏移距离(")
      (princ offd0)
      (princ ")")                        ;输入偏移距离
      (setq offd (getdist))
      (if (= offd nil)
        (setq offd offd0)
        (setq offd0 offd)
      )
    )
  )

  (princ "\n请选择线段,弧,圆,多段线:")
  (setq dx_ss (ssget))
  (if (or (eq py_fs "s") (eq py_fs "S"))
    (setq pt (list 0 0))
    (setq pt (getpoint "\n请选择基点"))
  )                                        ;输入偏移基点

  (setq n 0)
  (while (< n (sslength dx_ss))
    (setq dx_n (ssname dx_ss n))
    (if
      (or (eq py_fs "t") (eq py_fs "T"))
       (command "OFFSET" "t" dx_n pt "")
       (progn
         (cond
           ((or        (eq "LINE" (cdr (assoc '0 (entget dx_n))))
                (eq "LWPOLYLINE" (cdr (assoc '0 (entget dx_n))))
            )
            (command "OFFSET" offd dx_n pt "") ;正向偏移
            (setq ptst (cdr (assoc '10 (entget dx_n))))
            (setq pten (cdr (assoc '10 (entget (entlast)))))

            (if        (or (eq py_fs "f") (eq py_fs "F")) ;正向偏移删除
              (command "ERASE" "l" "")
            )
            (if        (or (eq py_fs "f")
                    (eq py_fs "F")
                    (eq py_fs "s")
                    (eq py_fs "S")
                )                        ;反向偏移
              (progn
                (setq pt0 (list        (- (* 2 (nth 0 ptst)) (nth 0 pten))
                                (- (* 2 (nth 1 ptst)) (nth 1 pten))
                          )
                )
                (command "OFFSET" offd dx_n pt0 "")
              )
            )
           )
           ((or        (eq "ARC" (cdr (assoc '0 (entget dx_n))))
                (eq "CIRCLE" (cdr (assoc '0 (entget dx_n))))
            )
            (command "OFFSET" offd dx_n pt "") ;正向偏移
            (setq rst (cdr (assoc '40 (entget dx_n))))
            (setq ren (cdr (assoc '40 (entget (entlast)))))

            (if        (or (eq py_fs "s") (eq py_fs "S")) ;正向偏移复制
              (command "copy" "l" "" "0,0,0" "0,0,0")
            )
            (if        (or (eq py_fs "f")
                    (eq py_fs "F")
                    (eq py_fs "s")
                    (eq py_fs "S")
                )                        ;反向偏移
              (progn
                (setq r0 (- (* 2 rst) ren))
                (if (<= r0 0)
                  (command "ERASE" "l" "") ;正向偏移删除
                  (progn
                    (setq dx_n0 (entget (entlast)))
                    (setq dx_n0
                           (subst (cons '40 r0) (assoc '40 dx_n0) dx_n0)
                    )
                    (entmod dx_n0)
                  )                        ;正向偏移更改
                )
              )
            )
           )
         )

       )
    )
    (setq n (1+ n))
  )
  (command "undo" "e")                        ; 定义返点
  (setvar "cmdecho" 1)                        ; 打开命令提示
  (princ)
)

xmq1103

start4444 发表于 2020-9-2 11:16
反向的函数关键找到偏移方向点，你能把反向的方向点给计算出来就行，根据正向点来计算反向点，想想都头疼
...

好提取就帮我拼出一个来，确实难弄就算了，我就用你刚才给我的，点两点来用了，谢谢，麻烦你啦！！！！

start4444

xmq1103 发表于 2020-9-2 12:16
谢谢，有时间的话，看看这个函数能从里面找出点能利用的函数不，给您添麻烦了，谢谢我看不太懂，哪部分能 ...

你这个是根据对象类别来计算反向点，有点繁琐。
找了一下资料，这个vl 的最近点函数应该可以解决，而且比较便捷

(defun c:tt5(/ l lst lst2 p)
  (setq l(entsel"请选择偏移的基线："))
  (setq p (getpoint "点取偏移正方向："))
  (setq lst '(2 16 2 12));正向
        (setq lst2 '(18 22 6 14));反向
        (pianyi-3 l p lst 0)
        (pianyi-3 l p lst2 1)
        (princ)       
  )

(defun pianyi-3 (ent pt lst key / d obj ptx);正反向偏移子函数；[key=1:反向 / key=0:正向]
(vl-load-com)
(setq obj (vlax-ename->vla-object (car ent)))
(if (= key 1) (setq ptx (vlax-curve-getClosestPointTo obj pt) pt (polar ptx (angle pt ptx) 1)))
(setq d 0)
        (foreach x lst
        (setq d (+ d x))
        (command "offset" d ent "non" pt "")
        )               
)

xmq1103

start4444 发表于 2020-9-2 14:07
你这个是根据对象类别来计算反向点，有点繁琐。
找了一下资料，这个vl 的最近点函数应该可以解决，而且 ...

感谢，感谢，完美解决，太棒了！！！！

bai2000

网上maiko的函数：http://bbs.mjtd.com/forum.php?mo ... 92&page=3#pid775836
;函数名称 OFFSET
;函数用法 (OFFSET mode0 mode1 mode2 mode3 mode4 mode5)
;参数 mode0 :图元,选择集,图元表,obj对象
;参数 mode1 :偏移距离,可数据表(INT REAL)类型, 数据表'(2.5 3 3.5 4 4.5 5)
;参数 mode2 :正偏移                  t为偏移 nil为不偏移
;参数 mode3 :负偏移                  t为偏移 nil为不偏移
;参数 mode4 :偏移对象是否移到指定图层     nil为不移到指定层 输入字串为指定层
;参数 mode5 :是否删除原子线            t为删除原子线,nil为不删除

函数我也没找到在哪能下载

bai2000

网上前辈的源码，忘记哪位的，抱歉：
楼上改改，像这样才符合使用方便
;;;;;;;;;;;;;;;;;;;;;;;;;【江普咨询幕墙工具箱】LISP实验室;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;程序功能：一次偏移不同间距   [备注：]20190515
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun ustr (bit msg def spflag / inp nval)
  (setq OSM (Getvar "OSMODE" ))
  (if (and def (/= def ""))
    (setq msg (strcat "\n" msg " <" def ">: ")
          inp (getstring msg spflag)
          inp (if (= inp "")
                def
                inp
              )
    )
    (progn
      (if (= " " (substr msg (strlen msg) 1))
        (setq msg (strcat "\n" (substr msg 1 (1- (strlen msg))) ": "))
        (setq msg (strcat "\n" msg ": "))
      )
      (if (= bit 1)
        (while (= "" (setq inp (getstring msg spflag)))
          (prompt "\nInvalid string.")
        )
        (setq inp (getstring msg spflag))
      )
    )
  )
)

(Defun Off_Aux (ddL pnt)
  (setq Hdd 0)
  (while (setq dd (car ddL))
    (setq Hdd (+ Hdd dd))
    (command "_.offset" Hdd ee Pnt "")
    (setq ddL (cdr ddL))
  )
(setvar "OSMODE" OSM)
)

(defun C:qqq ()
   (setq cm (getvar "cmdecho")
   os (getvar "osmode"))
  (setvar "CMDECHO" 0)
  (command "color" "bylayer")

   (command "_undo" "be")
    (setlayer_lsp "ZT1_幕墙--分割线" 161)
  (setq a (uStr 0 "\n请依次输入偏移相对间距" *HddLst* T))
  (setq *HddLst* a)
  (setq ddLst (read (strcat "(" a ")")))
  (cond
    ;|
    ((setq ss (cadr (ssgetfirst)))
     (setq ee (ssname ss 0))
    )
    |;
    (T
     (prompt "\n请选择偏移的对象: ")
     (while (not (setq ee (entsel))))
    )
  )

  (setq Pt1 (getpoint "\nS请确定偏移方向: "))

  (cond
    ((null pt1)
     (setq p5  (osnap (cadr ee) "Mid")
           pa  (osnap (cadr ee) "end")
           vv  (angle pa p5)
           pt1 (polar p5 (+ vv 1.5) 8)
           pt2 (polar p5 (- vv 1.5) 8)
     )
    )
    (T (setq pt2 nil))
  )
  (Off_Aux ddLst pt1)
  (if pt2
    (Off_Aux ddLst pt2)
  )
(command "_undo" "e")
(setvar "OSMODE" os)
  (setvar "cmdecho" cm)
  (princ)
)

xmq1103

bai2000 发表于 2020-9-2 20:20
网上前辈的源码，忘记哪位的，抱歉：
楼上改改，像这样才符合使用方便
;;;;;;;;;;;;;;;;;;;;;;;;;【江普 ...

感谢热心的你，共享的函数非常非常棒，这个的通用性非常强，应该适合很多人，我也收下了，可以用起来的。
我这个帖子要解决的问题的初衷是，经常有几组使用频率非常高的几个间隔组合需要偏移，因此，代码里面直接定义好间隔后，调用代码直接进行偏移，不用再挨个的输入了。你的这个更适合大部分人，谢谢共享出来。