全部的币都拿出来了！求实现自动TRIM功能！

革天明

langjs 发表于 2012-4-29 20:23
虽然画的圆是干啥的不知道，因为好改，就给你改了一下，上面的图纸都能通过。

想要在如图所示的P1和p2生成一个圆，圆的半径为：此点垂直向上且在多段线上的Y坐标最大的点  与此点 的Y值之差。



我自定义了一个函数，用于求得符合上述条件的点，但正确率不高。
num一般为p1 p2点的X坐标值，PTList为多段线各顶点坐标，返回值为符合此条件的所有点组成的点表，而且此点表以坐标点的Y值进行递减排序。
(defun cirr(num ptlist / k)
    (setq k 0 rptlist '())
    (repeat (length ptlist)
      (if (equal num (car(nth k ptlist)) 0.000001)
(setq rptlist(cons (nth k ptlist) rptlist))
      )
      (setq k(1+ k))
    )
    (vl-sort rptlist
    (function (lambda (e1 e2)
         (> (cadr e1)(cadr e2))
       )
    )
    )
    rptlist
  )
现在如何修改才能在P1和p2两个点生成符合上述要求的圆？

革天明

下面我是修改后的全部代码，
(defun c:nb (/                3p           c01              c02         nb-ssget-xy
             nb-ssget-p1           nb-ssget-p2                 nb-ytm-miny
             nb-ytm-minx           nb-ytm-maxy                 nb-ytm-maxx
             dls        ent           i              k                 l
             ll                lst01           m              maxp         minp
             mpt1        mpt2           n              nb-3p-p1         nb-3p-p2
             nb-3p-p3        nb-cut-pt1 nb-cut-pt2 nb-cut-pt3 nb-entsel
             nb-max        nb-min           nb-miny    nb-osmode         nb-ptlist
             nn                pt01           pt02              pt03         pt04
             ptlist        ptlist1           x              nb-circle-color
            )
  (defun get-pline-point (ent / n ptlist ptlist1)
    (vl-load-com)
    (setq ptlist '()
          ptlist1 '()
          n 0
    )
    (setq ptlist (vlax-safearray->list
                   (vlax-variant-value
                     (vlax-get-property
                       (vlax-ename->vla-object ent)
                       'coordinates
                     )
                   )
                 )
    )
    (cond
      ((= "LWPOLYLINE" (cdr (assoc 0 (entget ent))))
       (progn
         (repeat (/ (length ptlist) 2)
           (setq ptlist1 (cons (list (nth n ptlist)
                                     (nth (setq n (1+ n))
                                          ptlist
                                     )
                               )
                               ptlist1
                         )
           )
           (setq n (1+ n))
         )
       )
      )
      ((= "POLYLINE" (cdr (assoc 0 (entget ent))))
       (progn
         (repeat (/ (length ptlist) 3)
           (setq ptlist1 (cons (list (nth n ptlist)
                                     (nth (setq n (1+ n))
                                          ptlist
                                     )
                                     (nth (setq n (1+ n))
                                          ptlist
                                     )
                               )
                               ptlist1
                         )
           )
           (setq n (1+ n))
         )
       )
      )
    )
    (reverse ptlist1)
  )
  (defun gu_xl_3p (l n / k ll m nn)
    (setq k  -1
          nn (length l)
    )
    (mapcar
      (function        (lambda        (a / ll m)
                  (setq        k (1+ k)
                        m k
                  )
                  (repeat n
                    (setq ll (append
                               ll
                               (list (nth m l))
                             )
                    )
                    (setq m (rem (1+ m) nn))
                    ll
                  )
                )
      )
      l
    )
  )
  (defun mpt (mpt1 mpt2)
    (polar mpt1 (angle mpt1 mpt2) (/ (distance mpt1 mpt2) 2))
  )
  (defun trimline (nb-3p-p2 dls /)
    (vl-cmdf "Zoom" "C" nb-3p-p2 (* 6 dls))
    (command "trim"
             ""
             "C"
             (list (+ (car nb-3p-p2) (* 0.016 dls))
                   (+ (cadr nb-3p-p2) (* 0.016 dls))
             )
             (list (- (car nb-3p-p2)
                      (* 0.016 dls)
                   )
                   (- (cadr nb-3p-p2)
                      (* 0.016 dls)
                   )
             )
             ""
    )
  )
  (defun cirr(num ptlist / k)
    (setq k 0 rptlist '())
    (repeat (length ptlist)
      (if (equal num (car(nth k ptlist)) 0.000001)
        (setq rptlist(cons (nth k ptlist) rptlist))
      )
      (setq k(1+ k))
    )
    (vl-sort rptlist
           (function (lambda (e1 e2)
                       (> (cadr e1)(cadr e2))
                     )
           )
    )
    rptlist
  )
  (vl-load-com)
  (setq nb-osmode (getvar "osmode"))
  (setq c01 (trans (getvar "viewctr") 1 2))
  (setq c02 (getvar "viewsize"))
  (setvar "osmode" 0)
  (setvar "CMDECHO" 0)
  (command ".UNDO" "BE")
  (prompt "\n请选择要处理的对象")
  (setq nb-ssget-xy (last (ssnamex (ssget) 0)))
  (setq        nb-ssget-p1 (last (cadr nb-ssget-xy))
        nb-ssget-p2 (last (cadddr nb-ssget-xy))
  )
  (if (> (car nb-ssget-p2) (car nb-ssget-p1))
    (progn
      (command "EXPLODE" (ssget "W" nb-ssget-p1 nb-ssget-p2) "")
      (c:CF-20120416)
      (vl-cmdf "PEDIT"
               "M"
               (ssget "W" nb-ssget-p1 nb-ssget-p2)
               ""
               "Y"
               "J"
               ""
               ""
      )
    )
    (progn
      (command "EXPLODE" (ssget "W" nb-ssget-p2 nb-ssget-p1) "")
      (c:CF-20120416)
      (vl-cmdf "PEDIT"
               "M"
               (ssget "W" nb-ssget-p2 nb-ssget-p1)
               ""
               "Y"
               "J"
               ""
               ""
      )
    )
  )
  (setq nb-entsel (entlast))
  (setq nb-ptlist (get-pline-point nb-entsel))
  (setq        nb-ytm-miny
         (apply 'min (mapcar '(lambda (x) (cadr x)) nb-ptlist))
  )
  (setq        nb-ytm-minx
         (apply 'min (mapcar '(lambda (x) (car x)) nb-ptlist))
  )
  (setq        nb-ytm-maxy
         (apply 'max (mapcar '(lambda (x) (cadr x)) nb-ptlist))
  )
  (setq        nb-ytm-maxx
         (apply 'max (mapcar '(lambda (x) (car x)) nb-ptlist))
  )
  (setq nb-ytm-cirr1(cadr(nth 0(cirr nb-ytm-maxx nb-ptlist))))
  (setq nb-ytm-cirr2(cadr(nth 0(cirr nb-ytm-minx nb-ptlist))))
  (vla-getboundingbox
    (vlax-ename->vla-object nb-entsel)
    'minp
    'maxp
  )
  (setq nb-max (vlax-safearray->list maxp))
  (setq nb-min (vlax-safearray->list minp))
  (setq nb-miny (cadr nb-min))
  (setq nb-ptlist (gu_xl_3p nb-ptlist 3))
  (setq        i 0
        k 0
        lst01 '()
  )
  (repeat (length nb-ptlist)
    (setq 3p           (nth i nb-ptlist)
          nb-3p-p1 (nth 0 3p)
          nb-3p-p2 (nth 1 3p)
          nb-3p-p3 (nth 2 3p)
    )
    (if        (and
          (equal (distance nb-3p-p1 nb-3p-p2)
                 (distance nb-3p-p3 nb-3p-p2)
                 (* 0.001 (distance nb-3p-p1 nb-3p-p2))
          )
          (equal (cadr nb-3p-p1)
                 (cadr nb-3p-p3)
                 (* 0.001 (distance nb-3p-p1 nb-3p-p2))
          )
          (< (cadr nb-3p-p2) (cadr nb-3p-p3))
        )
      (progn
        (vl-cmdf "line"
                 (setq pt02 (mpt nb-3p-p1 nb-3p-p2))
                 (setq pt01 (list (car (mpt nb-3p-p1 nb-3p-p2)) nb-miny))
                 ""
        )
        (vl-cmdf "line"
                 (setq pt04 (mpt nb-3p-p2 nb-3p-p3))
                 (setq pt03 (list (car (mpt nb-3p-p2 nb-3p-p3)) nb-miny))
                 ""
        )
        (setq lst01 (cons (list pt01 (distance pt01 pt02)) lst01))
        (setq lst01 (cons (list pt03 (distance pt03 pt04)) lst01))
        (setq nb-cut-pt1 (mpt (mpt nb-3p-p1 nb-3p-p2) nb-3p-p2)
              nb-cut-pt2 (mpt (mpt nb-3p-p3 nb-3p-p2) nb-3p-p2)
              nb-cut-pt3 (list (car nb-3p-p2) nb-miny)
        )
        (setq dls (distance nb-3p-p1 nb-3p-p2))
        (trimline nb-3p-p2 dls)
        (trimline nb-3p-p2 dls)
        (trimline (list (car nb-3p-p2) nb-miny) dls)
      )
    )
    (setq i (1+ i))
  )
  (vl-cmdf "Zoom" "C" c01 c02)
  (vl-cmdf "PEDIT"
           "M"
           (ssget "C" nb-min nb-max)
           ""
           "Y"
           "J"
           ""
           ""
  )
  (vl-cmdf "REVOLVE"
           (ssget "C" nb-min nb-max)
           ""
           nb-min
           (list (car nb-max) nb-miny)
           "360"
  )
  (setq nb-circle-color 0)
  (repeat (length lst01)
    (vl-cmdf "circle"
             (car (nth nb-circle-color lst01))
             (cadr (nth nb-circle-color lst01))
    )
    (setq nb-circle-color (1+ nb-circle-color))
    (if        (or (wcmatch (vl-prin1-to-string (/ (- nb-circle-color 2) 4.0))
                     "*.0"
            )
            (wcmatch (vl-prin1-to-string (/ (- nb-circle-color 3) 4.0))
                     "*.0"
            )
        )
      (COMMAND "CHANGE" (entlast) "" "PROPERTIES" "C" "3" "")
      (COMMAND "CHANGE" (entlast) "" "PROPERTIES" "C" "1" "")
    )
  )
  (if (> (- nb-ytm-cirr2 nb-ytm-miny) 0)
    (progn
      (command "circle" (list nb-ytm-minx nb-ytm-miny) (- nb-ytm-cirr2 nb-ytm-miny))
      (COMMAND "CHANGE" (entlast) "" "PROPERTIES" "C" "1" "")
      (command "DIMRADIUS"
           (list (entlast)
                 (polar (list nb-ytm-minx nb-ytm-miny) (* pi 0.75) 3)
           )
           (polar (list nb-ytm-minx nb-ytm-miny) (* pi 0.75) 7)
      )
    )
  )
  (if (> (- nb-ytm-cirr1 nb-ytm-miny) 45)
    (command "circle" (list nb-ytm-maxx nb-ytm-miny) (- nb-ytm-cirr1 nb-ytm-miny))
  )
  (command ".UNDO" "E")
  (setvar "osmode" nb-osmode)
  (princ)
)