单边偏移求助

nonlittle

源码出自：http://bbs.mjtd.com/thread-90498-1-1.html

希望高手解决一下能够实现每次只偏移多边形的一条边或弧线，偏移以后同源对象延长线或倒角闭合任然形成多段线，偏移后将源对象删除，只保留偏移后对象。

xj6019

哈哈 这个有难度  前来围观高手猎奇

xtjd

http://bbs.mjtd.com/thread-110058-1-1.html
;;;LWPOLYLINE线单边移动函数
;;;by edata @mjtd
;;;2014-5-13
(defun sk_offset_single(/ ANG1 ANG2 CPT ENT ENT1 INDEXMAX INDEXMAX1+ INDEXMAX2 INDEXMIN INDEXMIN1 INDEXMIN1- IPT1 IPT1_A IPT1_B
            IPT2 IPT2_A IPT2_B IS_CLOSED NEW1 NEW2 NEW3 NEW4 OBJ  OF_DIST1 P0 P1 P11 P11BULGE P11MIN- P2 P21
            P21BULGE P21MAX+ PPX PX SK_COORDS VB_NEW1 VB_NEW2 VB_NEW3 VB_NEW4)
  ;;;组码值提取(sk_dxf 图元名 组码)
(defun sk_dxf(en code)
    (if(and(=(type en) 'ENAME)(= (type code) 'INT))
      (cdr(assoc code (entget en))))
  )
;;;计算cp到p1 p2的垂足点
(defun PerToLine  (cp p1 p2 / norm)
  (setq        norm (mapcar '- p2 p1)
        p1   (trans p1 0 norm)
        cp   (trans cp 0 norm)
        )
  (trans (list (car p1) (cadr p1) (caddr cp)) norm 0)
  )
  (defun *error*_New (msg)
  (and *error*_Old(setq *error* *error*_Old))
  (if (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
    (if        (= (getvar "LOCALE") "CHS")
      (princ "\n用户按了<Esc>强制退出")
      (princ "\nYou cancelled The operation!")
    )
    (princ (strcat "\n" msg))
  )
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setvar "cmdecho" 0)
  (command "undo" "e")
  (setvar "cmdecho" 1)
  (princ)
)
  (vla-StartUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (setq *error*_Old *error*)                ;保存出错处理函数
  (setq *error* *error*_New)
  ;;;;;主程序
  (vl-load-com)
  (if(setq of_dist1(getdist (strcat "\n输入偏移距离["(if of_dist (rtos of_dist) "0")"]:")))(setq of_dist of_dist1))
  (while(and of_dist (/= of_dist 0)
          (and(setq ent1(entsel "\n选择线:"))(or (= (sk_dxf (car ent1) 0 ) "LWPOLYLINE")(= (sk_dxf (car ent1) 0 ) "LINE")))
          (car (list t(redraw (car ent1) 3)))
    (setq p0(getpoint "\n指定偏移方向:")))
    (if(= (sk_dxf (car ent1) 0 ) "LWPOLYLINE")
    (progn
      (setq ent(car ent1)
            px(cadr ent1)
            obj(vlax-ename->vla-object (car ent1)))
      (setq is_closed (sk_dxf ent 70)
            sk_Coords (sk_dxf ent 90))      
      (setq ppx(vlax-curve-getClosestPointTo obj px)
            indexmin1(fix (vlax-curve-getParamAtPoint obj ppx))
            indexmax2(1+ indexmin1)
            indexmin(min indexmin1 indexmax2)
            indexmax(max indexmin1 indexmax2)
            )
      
      (if(and (= indexmin (1- sk_Coords))(= indexmax sk_Coords))
        (setq indexmin1- (1- indexmin )              
              indexmax 0              
              indexmax1+ 1)
        (if (and (= indexmin 0)(/= indexmax (1- sk_Coords)))
          (setq indexmin1- (1- sk_Coords)
                indexmax1+ (1+ indexmax ))
          (if (= indexmax (1- sk_Coords))
            (setq indexmax1+  0 indexmin1- (1- indexmin))
            (setq indexmin1- (1- indexmin)
                  indexmax1+ (1+ indexmax )))))
      (setq p1(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmin)))
            p2(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmax)))
            p11(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmin1-)))
            p21(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj indexmax1+)))
            p11bulge(vla-getbulge obj indexmin1-)
            p21bulge(vla-getbulge obj indexmax))
      (if(not(equal p21bulge 0.0 1e-8))(setq p21max+(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj (1+ indexmax1+))))))
      (if(not(equal p11bulge 0.0 1e-8))
        (progn         
        (setq p11min-(vlax-safearray->list(vlax-variant-value(vla-get-Coordinate obj (if (zerop indexmin1-) (1- sk_Coords)(1- indexmin1-))))))        
        )
        )      
      (setq cpt (PerToLine p0 p1 p2)
            ang1(angle cpt p0)
            ang2(angle p1 p2)
            new1(polar p1 ang1 of_dist)
            new2(polar p2 ang1 of_dist)
            ipt1(inters new1 new2 p1 p11 nil)
            ipt2(inters new1 new2 p2 p21 nil)   
            )
      (if(and (= is_closed 0) (= indexmin 0) )
        (setq ipt1 new1))
      (if(and (= is_closed 0) (= indexmax (1- sk_Coords)) )
        (setq ipt2 new2))      
      (if p11min- (setq ipt1_a(inters p1 p2 p11 p11min- nil)
                        ipt1_b(inters new1 new2 p11 p11min- nil)
                        ipt1(polar ipt1_b (angle p1 p2)(distance ipt1_a p1))
                        new3(polar ipt1_b (angle p11 p11min-)(distance ipt1_a p11))                        
                        vb_new3(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car new3)(cadr new3)))))
      (if p21max+ (setq ipt2_a(inters p1 p2 p21 p21max+ nil)
                        ipt2_b(inters new1 new2 p21 p21max+ nil)
                        ipt2(polar ipt2_b (angle p2 p1)(distance ipt2_a p2))
                        new4(polar ipt2_b (angle p21 p21max+)(distance ipt2_a p21))                        
                        vb_new4(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car new4)(cadr new4)))))
      (setq vb_new1(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car ipt1)(cadr ipt1)))            
            vb_new2(vlax-safearray-fill(vlax-make-safearray vlax-vbdouble '(0 . 1)) (list(car ipt2)(cadr ipt2)))
            )
      (if vb_new3 (progn
                    (vla-put-Coordinate obj indexmin1- vb_new3)
                    (vla-put-Coordinate obj indexmin  vb_new1))
        (vla-put-Coordinate obj indexmin  vb_new1)
        )
      (if vb_new4 (progn
                    (vla-put-Coordinate obj indexmax1+ vb_new4)
                    (vla-put-Coordinate obj indexmax  vb_new2))
        (vla-put-Coordinate obj indexmax  vb_new2)
        )
      (progn
        (setq p11min- nil
              p21max+ nil
              vb_new1 nil
              vb_new2 nil
              vb_new3 nil
              vb_new4 nil
        ))
      (vla-update obj)
      )     
      )   
    )
(if ent1 (redraw (car ent1) 4))
  (and *error*_Old(setq *error* *error*_Old))
  (vla-EndUndoMark (vla-get-ActiveDocument (vlax-get-acad-object)))
  (princ)
  )
(defun c:tt nil
  (sk_offset_single)
  (princ)
  )
(prompt "轻多段线(LWPOLYLINE)单边边偏移命令 TT")
(princ)

nonlittle

xtjd 发表于 2022-11-15 13:16
http://bbs.mjtd.com/thread-110058-1-1.html
;;;LWPOLYLINE线单边移动函数
;;;by edata @mjtd

非常棒，能不能再给看看偏移闭合多段线起点和终点位置的时候不闭合，能给解决一下吗，大神。

ZYX2129

谢谢大佬的分享！！！！

刘炎华

xtjd 发表于 2022-11-15 13:16
http://bbs.mjtd.com/thread-110058-1-1.html
;;;LWPOLYLINE线单边移动函数
;;;by edata @mjtd

大师，在用户坐标系下使用会出错呢