框内选择

guosheyang

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

845245015

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

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

sandyvs

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 ...

感觉应该加个容差，不然外侧挨着的也都选上了