API应用快速休整Pline

st788796 · 发表于 2013-12-8 11:03:21

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

您需要登录才可以下载或查看，没有账号？立即注册

×

(defun c:tt (/ p pts pl sp ep npl ptl nnpl)
(while (setq p (if pts
(getpoint (car pts) "\nPoint: ")
(getpoint "\nPoint: ")
)
)
(setq pts (cons p pts))
(if (> (length pts) 1)
(mapcar '(lambda (p1 p2) (grdraw p1 p2 1)) pts (cdr pts))
)
)
(if
(and pts
(setq
ss (xdrx_pickset_getatpoint (last pts) '((0 . "lwpolyline")))
)
)
(progn
(setq ptl (list (car pts) (last pts))
pl (ssname ss 0)
sp (xdrx_curve_getparamatpoint pl (car ptl))
ep (xdrx_curve_getparamatpoint pl (cadr ptl))
nnpl (xdrx_pickset->ents (xdrx_curve_getsplitcurves pl sp ep))
)
(if (vlax-curve-isclosed pl)
(xdrx_entity_delete
(car
(vl-sort
nnpl
'(lambda (x1 x2)
(< (cadr (xdrx_getarea x1)) (cadr (xdrx_getarea x2)))
)
)
)
)
(mapcar '(lambda (x / info ppl)
(setq info (xdrx_curve_getpoint x)
ppl (list (car info) (caddr info))
)
(if (or (equal ppl ptl 1e-5)
(equal ppl (reverse ptl) 1e-5)
)
(xdrx_entity_delete x)
)
)
nnpl
)
)
(setq npl (apply 'xdrx_polyline_make pts)
nnpl (vl-remove-if-not '(lambda (x) (entget x)) nnpl)
)
(vl-cmdf ".pedit" pl "j" npl)
(if nnpl
(foreach x nnpl (vl-cmdf x))
)
(vl-cmdf "")
(vl-cmdf "")
)
)
(princ)
)

(defun c:tt (/ p pts pl sp ep npl ptl nnpl) 
  (while (setq p (if pts 
                   (getpoint (car pts) "\nPoint: ") 
                   (getpoint "\nPoint: ") 
                 ) 
         ) 
    (setq pts (cons p pts)) 
    (if        (> (length pts) 1) 
      (mapcar '(lambda (p1 p2) (grdraw p1 p2 1)) pts (cdr pts)) 
    ) 
  ) 
  (if 
    (and pts 
         (setq 
           ss (xdrx_pickset_getatpoint (last pts) '((0 . "lwpolyline"))) 
         ) 
    ) 
     (progn 
       (setq ptl  (list (car pts) (last pts)) 
             pl          (ssname ss 0) 
             sp          (xdrx_curve_getparamatpoint pl (car ptl)) 
             ep          (xdrx_curve_getparamatpoint pl (cadr ptl)) 
             nnpl (xdrx_pickset->ents (xdrx_curve_getsplitcurves pl sp ep)) 
       ) 
       (if (vlax-curve-isclosed pl) 
         (xdrx_entity_delete 
           (car 
             (vl-sort 
               nnpl 
               '(lambda        (x1 x2) 
                  (< (cadr (xdrx_getarea x1)) (cadr (xdrx_getarea x2))) 
                ) 
             ) 
           ) 
         ) 
         (mapcar '(lambda (x / info ppl) 
                    (setq info (xdrx_curve_getpoint x) 
                          ppl  (list (car info) (caddr info)) 
                    ) 
                    (if        (or (equal ppl ptl 1e-5) 
                            (equal ppl (reverse ptl) 1e-5) 
                        ) 
                      (xdrx_entity_delete x) 
                    ) 
                  ) 
                 nnpl 
         ) 
       ) 
       (setq npl  (apply 'xdrx_polyline_make pts) 
             nnpl (vl-remove-if-not '(lambda (x) (entget x)) nnpl) 
       ) 
       (vl-cmdf ".pedit" pl "j" npl) 
       (if nnpl 
         (foreach x nnpl (vl-cmdf x)) 
       ) 
       (vl-cmdf "") 
       (vl-cmdf "") 
     ) 
  ) 
  (princ) 
)

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

[教学] API应用 快速休整Pline

马上注册，结交更多好友，享用更多功能，让你轻松玩转社区。

[教学] API应用快速休整Pline