点集offset

/db_自贡黄明儒_ · 发表于 2018-2-19 20:02:33

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

对于点集（可以组成凸多边形）偏移，假如不使用命令 _offset，有什么好的写法么？

marting · 发表于 2018-2-19 21:31:22

本帖最后由 marting 于 2018-2-19 21:34 编辑

不用OFFSET命令，那就vla-offset了
下面代码，没加入错误判断，需要自己加上就行了。

(defun pntsOffset (pts dis / o)
(entmakex
(append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length pts))
)
(mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) pts)
)
)
(setq o (vlax-ename->vla-object (setq e (entlast))))
(vla-put-closed o :vlax-true)
(vla-offset o dis)
(vla-delete o)
(setq pts (vl-remove-if
'(lambda (x) (/= (car x) 10))
(entget (entlast))
)
)
(entdel (entlast))
(mapcar '(lambda(x)(append (cdr x) (list 0.0))) pts)
)

marting · 发表于 2018-2-19 21:45:59

加入出错判断

(defun pntsOffset (pts dis / o)
(entmakex
(append (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 (length pts))
)
(mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) pts)
)
)
(setq o (vlax-ename->vla-object (setq e (entlast))))
(vla-put-closed o :vlax-true)
(if (not (vl-catch-all-error-p
(vl-catch-all-apply 'vla-offset (list o dis))
)
)
(progn (vla-delete o)
(setq pts (vl-remove-if
'(lambda (x) (/= (car x) 10))
(entget (entlast))
)
)
(entdel (entlast))
(mapcar '(lambda (x) (append (cdr x) (list 0.0))) pts)
)
(progn (vla-delete o) (princ "指定距离无法offset.") (princ))
)
)

(defun pntsOffset (pts dis / o) 
  (entmakex 
    (append (list '(0 . "LWPOLYLINE") 
                  '(100 . "AcDbEntity") 
                  '(100 . "AcDbPolyline") 
                  (cons 90 (length pts)) 
            ) 
            (mapcar '(lambda (x) (cons 10 (list (car x) (cadr x)))) pts) 
    ) 
  ) 
  (setq o (vlax-ename->vla-object (setq e (entlast)))) 
  (vla-put-closed o :vlax-true) 
  (if (not (vl-catch-all-error-p 
             (vl-catch-all-apply 'vla-offset (list o dis)) 
           ) 
      ) 
    (progn (vla-delete o) 
           (setq pts (vl-remove-if 
                       '(lambda (x) (/= (car x) 10)) 
                       (entget (entlast)) 
                     ) 
           ) 
           (entdel (entlast)) 
           (mapcar '(lambda (x) (append (cdr x) (list 0.0))) pts) 
    ) 
    (progn (vla-delete o) (princ "指定距离无法offset.") (princ)) 
  ) 
)

/db_自贡黄明儒_ · 发表于 2018-2-19 22:13:00

本帖最后由 /db_自贡黄明儒_ 于 2018-2-19 22:15 编辑

marting 发表于 2018-2-19 21:45

我先求点，然后生成多段线

;;多段线顶点
;;(setq pts (_HH:GetLwPts (car (entsel))))
(defun _HH:GetLwPts (e)
(mapcar 'cdr
(vl-remove-if-not '(lambda (x) (equal 10 (car x)))
(entget e)
)
)
)
;;(_PtsOffset pts 20)
(defun _PtsOffset (pts d Flag / 5PI ANG L X Y)
(if Flag
(setq 5pi (* pi -0.5))
(setq 5pi (* pi 0.5))
)
(mapcar
'(lambda (x y)
(setq ang (+ (angle x y) 5pi))
(setq L (cons (list (polar x ang d) (polar y ang d)) L))
)
(cons (last pts) pts)
pts
)
(setq pts nil)
(mapcar
'(lambda (x y)
(setq pts (cons (apply 'inters (append x y (list nil))) pts))
)
(cons (last L) L)
L
)
pts
)
;;由于不知点集顺时针还是逆时针，Flag=T时外偏移
(defun _PtsOffsetOutIn (pts d Flag / D1 D2 FUN P)
(if Flag
(setq fun >)
(setq fun <)
)
(setq d1 (distance (car pts) (cadr pts)))
(setq p (_PtsOffset pts d Flag))
(setq d2 (distance (car p) (cadr p)))
(if (fun d2 d1)
p
(_PtsOffset pts d (not Flag))
)
)
;;测试
(defun C:w1 (/ L PTS);向外offset
(setq pts (_HH:GetLwPts (car (entsel))))
(setq L (_PtsOffsetOutIn pts 20 T))
(_EntmakeLWPOLYLINE L)
(princ)
)
(defun C:w2 (/ L PTS);向内offset
(setq pts (_HH:GetLwPts (car (entsel))))
(setq L (_PtsOffsetOutIn pts 20 nil))
(_EntmakeLWPOLYLINE L)
(princ)
)

;;多段线顶点 
;;(setq pts (_HH:GetLwPts (car (entsel)))) 
(defun _HH:GetLwPts (e) 
  (mapcar 'cdr 
          (vl-remove-if-not '(lambda (x) (equal 10 (car x))) 
                            (entget e) 
          ) 
  ) 
) 
;;(_PtsOffset pts 20) 
(defun _PtsOffset (pts d Flag / 5PI ANG L X Y) 
  (if Flag 
    (setq 5pi (* pi -0.5)) 
    (setq 5pi (* pi 0.5)) 
  ) 
  (mapcar 
    '(lambda (x y) 
       (setq ang (+ (angle x y) 5pi)) 
       (setq L (cons (list (polar x ang d) (polar y ang d)) L)) 
     ) 
    (cons (last pts) pts) 
    pts 
  ) 
  (setq pts nil) 
  (mapcar 
    '(lambda (x y) 
       (setq pts (cons (apply 'inters (append x y (list nil))) pts)) 
     ) 
    (cons (last L) L) 
    L 
  ) 
  pts 
) 
;;由于不知点集顺时针还是逆时针，Flag=T时外偏移 
(defun _PtsOffsetOutIn (pts d Flag / D1 D2 FUN P) 
  (if Flag 
    (setq fun >) 
    (setq fun <) 
  ) 
  (setq d1 (distance (car pts) (cadr pts))) 
  (setq p (_PtsOffset pts d Flag)) 
  (setq d2 (distance (car p) (cadr p))) 
  (if (fun d2 d1) 
    p 
    (_PtsOffset pts d (not Flag)) 
  ) 
) 
 
;;测试 
(defun C:w1 (/ L PTS);向外offset 
  (setq pts (_HH:GetLwPts (car (entsel)))) 
  (setq L (_PtsOffsetOutIn pts 20 T)) 
  (_EntmakeLWPOLYLINE L) 
  (princ) 
) 
(defun C:w2 (/ L PTS);向内offset 
  (setq pts (_HH:GetLwPts (car (entsel)))) 
  (setq L (_PtsOffsetOutIn pts 20 nil)) 
  (_EntmakeLWPOLYLINE L) 
  (princ) 
)

marting · 发表于 2018-2-19 22:30:56

/db_自贡黄明儒_ 发表于 2018-2-19 22:13

函数最好是根据距离的正负，来外偏或者内偏，这样调用更方便。
距离的正负，根据OFFSET的选点方向确定，这样就不用人为的用固定的外偏或者内偏两个命令。

/db_自贡黄明儒_ · 发表于 2018-2-19 22:51:07

本帖最后由 /db_自贡黄明儒_ 于 2018-2-19 22:53 编辑

marting 发表于 2018-2-19 22:30

这个建议好{:4_4:}

marting · 发表于 2018-2-19 22:53:53

本帖最后由 marting 于 2018-2-19 22:55 编辑

/db_自贡黄明儒_ 发表于 2018-2-19 22:51

比如，下面这两个，可以让用户输入距离，一次多次偏移

登录/注册后可看大图

动态拖动偏移

登录/注册后可看大图

API应用 GetOffsetCurves批量偏移
64 个回复 - 4841 次查看
**** 本内容被作者隐藏 ****
2013-11-3 23:19 - st788796 - XDRX_API应用
XDGE几何库应用(14)--曲线Offset及点集Offset
1 个回复 - 739 次查看
在编程过程中有时会遇到一系列的点要进行偏移一个距离，在 A/VLisp 中通常要构造一个 Pline，通过这个 Pline 线 Offset 后获取新线的节点，然后删除这个线，直接计算这些点是没有办法做到的（可以看演示图片，中间有 ...
2014-9-22 21:03 - st788796 - XDRX_API应用

Lisphk · 发表于 2018-2-19 23:31:39

(defun c:staggeredoffset (/ d d2 obj offdir pp pp2 tmp1 tmp2)
(vl-load-com)
(if (and (setq obj (entsel "\nSelect object to offset: "))
(setq pp (cadr obj))
(setq obj (vlax-ename->vla-object (car obj)))
(/= (vla-get-objectname obj) "AcDbBlockReference")
(setq pp2 (getpoint pp "\nEnter direction and offset distance: "))
(setq d (distance pp pp2))
(setq d2 (* d 0.01))
)
(progn
(setq tmp1 (car (vlax-invoke obj "offset" d2))
tmp2 (car (vlax-invoke obj "offset" (* -1 d2)))
)
(if (< (distance pp2 (vlax-curve-getclosestpointto tmp1 pp2))
(distance pp2 (vlax-curve-getclosestpointto tmp2 pp2))
)
(setq offdir 1)
(setq offdir -1)
)
(vla-delete tmp1)
(vla-delete tmp2)
(while (and (setq obj (vl-catch-all-apply
'vlax-invoke
(list obj "offset" (* offdir d2))
)
)
(not (vl-catch-all-error-p obj))
(setq obj (car obj))
(<= d2 d)
)
(setq d2 (+ d2 (* 0.1 d2))
d (- d d2)
)
(vla-update obj)
)
)
)
(princ)
)

(defun c:staggeredoffset (/ d d2 obj offdir pp pp2 tmp1 tmp2) 
  (vl-load-com) 
  (if (and (setq obj (entsel "\nSelect object to offset: ")) 
           (setq pp (cadr obj)) 
           (setq obj (vlax-ename->vla-object (car obj))) 
           (/= (vla-get-objectname obj) "AcDbBlockReference") 
           (setq pp2 (getpoint pp "\nEnter direction and offset distance: ")) 
           (setq d (distance pp pp2)) 
           (setq d2 (* d 0.01)) 
      ) 
    (progn 
      (setq tmp1 (car (vlax-invoke obj "offset" d2)) 
            tmp2 (car (vlax-invoke obj "offset" (* -1 d2))) 
      ) 
      (if (< (distance pp2 (vlax-curve-getclosestpointto tmp1 pp2)) 
             (distance pp2 (vlax-curve-getclosestpointto tmp2 pp2)) 
          ) 
        (setq offdir 1) 
        (setq offdir -1) 
      ) 
      (vla-delete tmp1) 
      (vla-delete tmp2) 
      (while (and (setq        obj (vl-catch-all-apply 
                              'vlax-invoke 
                              (list obj "offset" (* offdir d2)) 
                            ) 
                  ) 
                  (not (vl-catch-all-error-p obj)) 
                  (setq obj (car obj)) 
                  (<= d2 d) 
             ) 
        (setq d2 (+ d2 (* 0.1 d2)) 
              d         (- d d2) 
        ) 
        (vla-update obj) 
      ) 
    ) 
  ) 
  (princ) 
)

yuren008 · 发表于 2018-2-20 08:47:26

比单个的偏移快多了

sicky111 · 发表于 2018-2-20 12:02:44

谢谢分享。

taoyi0727 · 发表于 2018-3-3 12:34:28

牛的人代码不能错过

liunian0524 · 发表于 2018-3-3 13:34:35

感谢各位的代码

xyp1964 · 发表于 2019-2-1 21:51:10

本帖最后由 xyp1964 于 2019-2-1 21:52 编辑

(defun c:tt ()
(setq e (entsel "\n选择偏移实体: ")
s1 (car e)
p1 (cadr e)
p2 (getpoint p1 "\n终点<退出>: ")
dd (distance p1 p2)
d0 (* dd 0.01)
d1 d0
)
(while (< d1 dd)
(command "offset" d1 s1 p2 "")
(setq d0 (* d0 1.1)
d1 (+ d1 d0)
)
)
(princ)
)

evayleung · 发表于 2019-2-1 22:04:41

谢谢分享。。。。。？。。。。？？？？？？？？？。

evayleung · 发表于 2019-2-1 22:06:10

谢谢分享。。。。。。。。。。。。。。。。。。。。。

账号		自动登录	找回密码
密码			立即注册

[研讨] 点集offset

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

评分

评分