明经CAD社区

 找回密码
 注册

QQ登录

只需一步,快速开始

搜索
查看: 425|回复: 3

求大佬完善一下这个偏移

[复制链接]
发表于 2023-5-25 23:07 | 显示全部楼层 |阅读模式
2明经币
求大佬帮忙完善一下,弄了一晚上,实在不会了




(defun c:KK (/ *error* en os p0)               
        (setq oldlayer (getvar "clayer"));_记录当前图层
        (if (not (tblsearch "layer" "图层AA"))
                (command "layer" "m" "图层AA" "c" 2 "" "lt" "DASHDOT" "" "")  ;建立图层
        )
        (setvar "clayer" "图层AA")
       
        (defun *error* (msg)
                (princ mag)
                (setvar "cmdecho" 1)
                (setvar "osmode" os)               
                (princ)
        )
        (setq os (getvar "osmode"))
        (mapcar 'setvar '("cmdecho" "osmode") '(0 0))
        (setq SS 50)
       
        (while (and (setq en (car (entsel))) (setq p0 (getpoint "\n偏移方向:")))
                (if (= SS 0)
                        (command "copy" en "" p0 p0)
                        (command "offset" SS en p0 "")
                )
               
                (VLA-PUT-LAYER (VLAX-ENAME->VLA-OBJECT (ENTLAST))"图层AA")       
                (setq ent (ssget "X" (list (cons 8 "图层A")(cons 410 (getvar 'ctab)))))
                (command "change" ent "" "p" "c" "bylayer" "")                                       
        )
        (setvar "clayer" OldLayer)       
        (setvar "cmdecho" 1)
        (setvar "osmode" os)
        (princ)
)

附件: 您需要 登录 才可以下载或查看,没有账号?注册

最佳答案

发表于 2023-5-25 23:07 | 显示全部楼层
  1. (defun c:KK (/ *error* en os p0)
  2.   (setq oldlayer (getvar "clayer")) ;_记录当前图层
  3.   (if (not (tblsearch "layer" "图层AA"))
  4.     (command "layer" "m" "图层AA" "c" 2 "" "lt" "DASHDOT" "" "")
  5.                                         ;建立图层
  6.   )
  7.   (setvar "clayer" "图层AA")

  8.   (defun *error* (msg)
  9.     (princ mag)
  10.     (setvar "cmdecho" 1)
  11.     (setvar "osmode" os)
  12.     (princ)
  13.   )
  14.   (setq os (getvar "osmode"))
  15.   (mapcar 'setvar '("cmdecho" "osmode") '(0 0))
  16.   (setq        SS   50
  17.         SS1  (SSADD)
  18.         LST  NIL
  19.         LST1 NIL
  20.         I    0
  21.   )
  22.   (SETQ SS1 (SSGET))
  23.   (setq p0 (getpoint "\n偏移方向:"))
  24.   (REPEAT (SSLENGTH SS1)
  25.     (SETQ E (SSNAME SS1 I))
  26.     (if        (= SS 0)
  27.       (command "copy" en "" p0 p0)
  28.       (command "offset" SS e p0 "")
  29.     )
  30.     (SETQ E1  (ENTLAST)
  31.           LST (CONS E1 LST)
  32.           I   (1+ I)
  33.     )
  34.     (VLA-PUT-LAYER (VLAX-ENAME->VLA-OBJECT (ENTLAST)) "图层AA")
  35.   )
  36.   (IF (> (LENGTH LST) 1)
  37.     (PROGN
  38.       (SETQ II 0
  39.             J (1+ II)
  40.       )
  41.       (REPEAT (1- (LENGTH LST))
  42.         (REPEAT        (- (LENGTH LST) J )
  43.           (SETQ        OBJ1 (vlax-ename->vla-object (NTH II LST))
  44.                 OBJ2 (vlax-ename->vla-object (NTH J LST))
  45.           )

  46.           (setq        ipts (vlax-variant-value
  47.                        (vla-intersectwith
  48.                          obj1
  49.                          obj2
  50.                          acExtendNone
  51.                        )
  52.                      )
  53.           )
  54.           (if (> (vlax-safearray-get-u-bound ipts 1) 0)
  55.             (progn
  56.               (setq ipts (vlax-safearray->list ipts)
  57.                                         ;将vla交点变体转化成表的形式
  58.                     lst1 '()
  59.               )
  60.               (if (> (length ipts) 3)        ;分离多个交点
  61.                 (repeat        (/ (length ipts) 3)
  62.                   (setq        lst1
  63.                              (cons (list (car ipts) (cadr ipts) (caddr ipts))
  64.                                    lst1
  65.                              )
  66.                         ipts (cdddr ipts)
  67.                   )
  68.                 )
  69.                 (SETQ LST1 (LIST ipts))
  70.               )


  71.               (FOREACH X (LIST (NTH II LST) (NTH J LST))
  72.                 (IF
  73.                   (> (DISTANCE (vlax-curve-getEndPoint X) (CAR LST1))
  74.                      (DISTANCE (vlax-curve-getStartPoint X) (CAR LST1))
  75.                   )
  76.                    (VLA-PUT-StartPoint
  77.                      (vlax-ename->vla-object X)
  78.                      (vlax-3D-point (CAR LST1))
  79.                    )
  80.                    (VLA-PUT-EndPoint
  81.                      (vlax-ename->vla-object X)
  82.                      (vlax-3D-point (CAR LST1))
  83.                    )
  84.                 )
  85.               )
  86.             )
  87.           )
  88.           (SETQ J (1+ J))
  89.         )
  90.         (SETQ II (1+ II))
  91.       )
  92.     )
  93.   )
  94.   (setq
  95.     ent        (ssget "X" (list (cons 8 "图层A") (cons 410 (getvar 'ctab))))
  96.   )
  97.   (command "change" ent "" "p" "c" "bylayer" "")
  98.   (setvar "clayer" OldLayer)
  99.   (setvar "cmdecho" 1)
  100.   (setvar "osmode" os)
  101.   (princ)
  102. )

评分

参与人数 1明经币 +1 收起 理由
_Levin + 1 很给力!

查看全部评分

回复

使用道具 举报

发表于 2023-5-28 09:30 | 显示全部楼层
来学习来学习来学习
回复

使用道具 举报

 楼主| 发表于 2023-6-2 17:34 | 显示全部楼层
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|CAD论坛|CAD教程|CAD下载|联系我们|关于明经|明经通道 ( 粤ICP备05003914号 )  
©2000-2023 明经通道 版权所有 本站代码,在未取得本站及作者授权的情况下,不得用于商业用途

GMT+8, 2024-3-29 04:31 , Processed in 0.164875 second(s), 26 queries , Gzip On.

Powered by Discuz! X3.4

Copyright © 2001-2021, Tencent Cloud.

快速回复 返回顶部 返回列表