guosheyang 发表于 2021-9-25 11:20:59

对于多段线包含圆弧的情况 好像选不全

845245015 发表于 2021-9-26 17:03:07

本帖最后由 845245015 于 2021-9-26 18:22 编辑

guosheyang 发表于 2021-9-25 11:20
对于多段线包含圆弧的情况 好像选不全
(defun c:tq (/ ADD DXF-10 ENT GET GET2 LEN LEN2 NN NN2 ENAME n pc r plist
             cenp radius STP ENPmp arcmidpoint d_end pt_mid divl plst)
(princ "\n功能 [批量选择多段内所有对象]")
(if (setq get (ssget '((0 . "LWPOLYLINE,CIRCLE,ARC"))))
    (progn
      (setq Len (sslength get)
            add (ssadd)
            )
      (repeat Len
      (setq nn (ssname get (setq Len (1- Len)))
            ent (entget nn)
            )
      (cond
          ((= (cdr (assoc 0 ent)) "CIRCLE")
         (setq n 0)
         (SETQ PC (cdr (assoc 10 ent))
               r (cdr (assoc 40 ent))
               )
         (repeat 180
             (setq dxf-10 (cons (list 10 (car (polar pc (/(* 2 n pi)180) r)) (cadr (polar pc (/(* 2 n pi)180) r))) dxf-10))
             (setq n (+ n 1))
             )
         )
          ((= (cdr (assoc 0 ent)) "ARC")
           (setq cenp (cdr (assoc 10 (entget nn))))
           (setq radius (cdr (assoc 40 (entget nn))))
           (setq STP (vlax-curve-getPointAtParam nn (vlax-curve-getstartparam nn)))
           (setq ENP (vlax-curve-getPointAtParam nn (vlax-curve-getEndParam nn)))
           (setq d_end (vlax-curve-getDistAtPoint nn ENP))
           (setq divl (/ d_end 10))
           (setq i 1)
           (setq plst '())
           (repeat 9
             (setq plst (cons (vlax-curve-getPointAtDist (vlax-ename->vla-object nn) (* divl i)) plst))
             (setq i (1+ i))
             )
           (setq plist (cons stp (cons enp plst)))
         (foreach x plist
             (setq dxf-10 (cons (list 10 (car x) (cadr x)) dxf-10))
             )
         )
          ((= (cdr (assoc 0 ent)) "LWPOLYLINE")
         (setq dxf-10 (vl-remove-if '(lambda (x) (/= (car x) 10)) ent))
         )
          )
      (setq get2   (ssget "_CP" (mapcar 'cdr dxf-10))
            Len2   (sslength get2)
            )
      (repeat Len2
          (setq nn2 (ssname get2 (setq Len2 (1- Len2))))
          (ssadd nn2 add)
          )
      )
      )
    )
(repeat (sslength get)
    (Setq ENAME (SsName get 0))
    (SsDel ENAME get)
    (SsDel ENAME add)
)
(sssetfirst nil add)
(princ)
)

894560869 发表于 2022-2-11 08:00:59

请教(真假)多段线首尾相连,判断是长方形还是正方形

sandyvs 发表于 2023-7-21 15:49:24

845245015 发表于 2021-9-26 17:03
(defun c:tq (/ ADD DXF-10 ENT GET GET2 LEN LEN2 NN NN2 ENAME n pc r plist
             cenp radius STP E ...

感觉应该加个容差，不然外侧挨着的也都选上了
页: 1 [2]
查看完整版本: 框内选择