批量偏移-画结构大样图专用！结构人的福音源码奉上

依然小小鸟 · 发表于 2018-9-10 12:51:23

本帖最后由依然小小鸟于 2018-9-13 11:31 编辑

画大样图专用如何实现结构线内偏移可设置偏移的距离可设置是否删除源对象希望偏移后线的图层为当前图层而不是源对象的图层并且偏移后线能自动裁剪

依然小小鸟 · 发表于 2018-9-10 20:26:48

5个人下载求大神帮忙

依然小小鸟 · 发表于 2018-9-10 13:53:42

本帖最后由依然小小鸟于 2018-9-11 18:13 编辑

找到一个类似的但是不能自动裁剪而且不能都向结构线内偏移不支持弧线

xyp1964 · 发表于 2018-9-13 21:15:08

(defun s2e (ss)
(if (= (type ss) 'pickset)
(vl-remove 'nil
(mapcar '(lambda (x / e)
(if (= (type (setq e (cadr x))) 'ename)
e
)
)
(ssnamex ss)
)
)
)
)
(defun plxyz (e fuz / i p pt) ;多段线节点三维坐标，连续重合点只取一个，根据fuz阀值过滤接近点
(setq i (- (vlax-curve-getendparam e)
(logand (cdr (assoc 70 (entget e))) 1)
-1
)
)
(while (setq i (1- i)
p (vlax-curve-getpointatparam e i)
)
(setq pt (if (equal (car pt) p fuz)
pt
(cons p pt)
)
)
)
)
(defun pldir (pt)
(> (apply '+
(mapcar '(lambda (x y) (- (* (car x) (cadr y)) (* (car y) (cadr x))))
(cons (last pt) pt)
pt
)
)
0
)
)
(defun c:tt ()
(setq dd (Udist 7 "" "偏移距离<输入或鼠标直接量取>" dd nil))
(vl-every '(lambda (x)
(mapcar '(lambda (x) (vla-put-color x 1))
(vlax-safearray->list
(vlax-variant-value
(vla-offset
(vlax-ename->vla-object x)
(if (pldir (plxyz x 1e-3))
(- dd)
dd
)
)
)
)
)
)
(s2e (ssget))
)
(princ)
)

(defun s2e (ss) 
  (if (= (type ss) 'pickset) 
    (vl-remove 'nil 
               (mapcar '(lambda        (x / e) 
                          (if (= (type (setq e (cadr x))) 'ename) 
                            e 
                          ) 
                        ) 
                       (ssnamex ss) 
               ) 
    ) 
  ) 
) 
(defun plxyz (e fuz / i p pt)                          ;多段线节点三维坐标，连续重合点只取一个，根据fuz阀值过滤接近点 
  (setq        i (- (vlax-curve-getendparam e) 
             (logand (cdr (assoc 70 (entget e))) 1) 
             -1 
          ) 
  ) 
  (while (setq i (1- i) 
               p (vlax-curve-getpointatparam e i) 
         ) 
    (setq pt (if (equal (car pt) p fuz) 
               pt 
               (cons p pt) 
             ) 
    ) 
  ) 
) 
(defun pldir (pt) 
  (> (apply '+ 
            (mapcar '(lambda (x y) (- (* (car x) (cadr y)) (* (car y) (cadr x)))) 
                    (cons (last pt) pt) 
                    pt 
            ) 
     ) 
     0 
  ) 
) 
(defun c:tt () 
  (setq dd (Udist 7 "" "偏移距离<输入或鼠标直接量取>" dd nil)) 
  (vl-every '(lambda (x) 
               (mapcar '(lambda (x) (vla-put-color x 1)) 
                       (vlax-safearray->list 
                         (vlax-variant-value 
                           (vla-offset 
                             (vlax-ename->vla-object x) 
                             (if (pldir (plxyz x 1e-3)) 
                               (- dd) 
                               dd 
                             ) 
                           ) 
                         ) 
                       ) 
               ) 
             ) 
            (s2e (ssget)) 
  ) 
  (princ) 
)

依然小小鸟 · 发表于 2018-9-13 11:26:28

拖明经群群友的福已经能批量偏移了但是没办法设置偏移距离和偏移后线的图层求大神能增加此项功能和偏移后线的图层为当前图层

yoyoho · 发表于 2018-9-13 17:33:45

感谢 "依然小小鸟" 分享程序,下载学习了!!!!

依然小小鸟 · 发表于 2018-9-13 17:55:40

yoyoho 发表于 2018-9-13 17:33
感谢 "依然小小鸟" 分享程序,下载学习了!!!!

... 有人能解决我的问题吗

xyp1964 · 发表于 2018-9-13 21:16:24

;; tt(曲线内偏移)
(defun c:tt ()
(xyp-Start)
(setq dd (Udist 7 "" "偏移距离<输入或鼠标直接量取>" dd nil))
(setq i -1)
(if (setq ss (ssget '((0 . "*LINE,ARC,CIRCLE,ELLIPSE"))))
(while (setq s1 (ssname ss (setq i (1+ i))))
(xyp-Offset s1 dd nil t nil)
)
)
(xyp-End)
)

依然小小鸟 · 发表于 2018-9-13 23:16:00

xyp1964 发表于 2018-9-13 21:15

院长大大怎么用不了呢我没装学院派工具箱我看这代码没有学院派函数吧

xyp1964 · 发表于 2018-9-14 00:09:15

依然小小鸟发表于 2018-9-13 23:16
院长大大怎么用不了呢我没装学院派工具箱我看这代码没有学院派函数吧

(defun udist (bit kwd msg def bpt / inp)
(if def
(setq msg (strcat "\n" msg "<" (rtos def) ">: ")
bit (* 2 (fix (/ bit 2)))
)
(setq msg (strcat "\n" msg ": "))
)
(initget bit kwd)
(setq inp (if bpt
(getdist msg bpt)
(getdist msg)
)
)
(if inp
inp
def
)
)

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

[提问] 批量偏移-画结构大样图专用！结构人的福音源码奉上

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

[提问] 批量偏移-画结构大样图专用！结构人的福音 源码奉上

本帖子中包含更多资源

本帖子中包含更多资源

本帖子中包含更多资源

[提问] 批量偏移-画结构大样图专用！结构人的福音源码奉上