孙玉坤 发表于 2019-8-6 19:10:59

给一个功能加一个 编组的功能

本帖最后由 孙玉坤 于 2019-8-10 18:23 编辑

单线变矩形后    变后的矩形想增加一个未命名组方便后边的选择。如果这是我变矩形后 手工编的组。希望增加一个自动的功能

yshf 发表于 2019-8-6 19:11:00

;程序改为如下
(defun c:aa ( /ss e ent ang pts)
      (setq cmd (getvar "cmdecho"))
      (setvar "cmdecho" 0)
      (command "_undo" "be")
      (if (not width) (setq width 1.00))
      (setq ssa (ssadd))
      (setq width (cond ((getdist
                              (strcat "\nEnter Width <" (rtos width 2 2)">: "))
                        )
                     (width)
                  )
      )
      (if (setq ss (ssget '((-4 . "<OR")
                              (-4 . "<AND")(0 . "LWPOLYLINE")(90 . 2)(42 . 0)(-4 . "AND>")
                              (0 . "LINE")
                           (-4 . "OR>")
                           )
                   )
          )
          (repeat (setq i (sslength ss))
            (setq e (ssname ss (Setq i (1- i))))
            (setq ent (entget e)
                    ang (angle        (setq sp (vlax-curve-getStartPoint e))
                                (setq ep (vlax-curve-getendPoint e))
                        )
            )
            (setq pts (mapcar '(lambda (pt)
                                     (list (setq p_ (polar pt (+ ang (/ pi 2.0)) (* 0.5 width)))
                                         (polar p_ (+ ang (* pi 1.5)) width)
                                     )
                                 )
                                 (list sp ep)
                        )
                    pts (apply 'append (list (car pts) (reverse (cadr pts))))
            )
            (entmakex (append (list (cons 0 "LWPOLYLINE")
                                    (cons 100 "AcDbEntity")
                                    (assoc 8 ent)
                                    (cons 100 "AcDbPolyline")
                                    (cons 90 (length pts))
                                    (cons 70 1)
                              )
                              (mapcar (function (lambda (p) (cons 10 p))) pts)
                         )
            )
              (setq ssa (ssadd (entlast) ssa))
            (entdel e)
          )
      )
      (if (> (sslength ssa) 0)
          (command "_group" "C" "*" "*" ssa "")
      )
      (command "_undo" "e")
      (setvar "cmdecho" cmd)
      (princ)
)

孙玉坤 发表于 2019-8-10 16:09:11

很难吗怎么没有法师来修改

Bao_lai 发表于 2019-8-10 23:05:33

本帖最后由 Bao_lai 于 2019-8-10 23:21 编辑

(command "-group" "C" "*" "*" (entlast) "")

1291500406 发表于 2019-8-11 00:18:27

孙玉坤 发表于 2019-8-10 16:09
很难吗怎么没有法师来修改
法师，我只玩武则天

孙玉坤 发表于 2019-8-11 01:45:57

Bao_lai 发表于 2019-8-10 23:05
(command "-group" "C" "*" "*" (entlast) "")

好像有一个是编组   其他没有
页: [1]
查看完整版本: 给一个功能加一个 编组的功能