;;亮显块内线圆

/db_自贡黄明儒_

(defun LM:Entity->PointList (ent / der di1 di2 di3 elst fun inc lst par rad)
  (setq elst (entget ent))
  (cond
    ((eq "POINT" (cdr (assoc 0 elst)))
     (list (cdr (assoc 10 elst)))
    )
    ((eq "LINE" (cdr (assoc 0 elst)))
     (list (cdr (assoc 10 elst)) (cdr (assoc 11 elst)))
    )
    ((member (cdr (assoc 0 elst)) '("CIRCLE" "ARC"))
     (setq di1 0.0
           di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
           inc (/ di2 (1+ (fix (* 35.0 (/ di2 (cdr (assoc 40 elst)) (+ pi pi))))))
           fun (if (vlax-curve-isclosed ent)
                 <
                 <=
               )
     )
     (while (fun di1 di2)
       (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
             di1 (+ di1 inc)
       )
     )
     lst
    )
    ((or (eq (cdr (assoc 0 elst)) "LWPOLYLINE")
         (and (eq (cdr (assoc 0 elst)) "POLYLINE")
              (zerop (logand (cdr (assoc 70 elst)) 80))
         )
     )
     (setq par 0)
     (repeat (fix (1+ (vlax-curve-getendparam ent)))
       (if (setq der (vlax-curve-getsecondderiv ent par))
         (if (equal der '(0.0 0.0 0.0) 1e-8)
           (setq lst (cons (vlax-curve-getpointatparam ent par) lst))
           (if (setq rad (distance '(0.0 0.0) (vlax-curve-getfirstderiv ent par))
                     di1 (vlax-curve-getdistatparam ent par)
                     di2 (vlax-curve-getdistatparam ent (1+ par))
               )
             (progn
               (setq inc (/ (- di2 di1) (1+ (fix (* 35.0 (/ (- di2 di1) rad (+ pi pi)))))))
               (while (< di1 di2)
                 (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
                       di1 (+ di1 inc)
                 )
               )
             )
           )
         )
       )
       (setq par (1+ par))
     )
     (if (or (vlax-curve-isclosed ent) (equal '(0.0 0.0 0.0) der 1e-8))
       lst
       (cons (vlax-curve-getendpoint ent) lst)
     )
    )
    ((eq (cdr (assoc 0 elst)) "ELLIPSE")
     (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
           di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
           di3 (* di2
                  (/ (+ pi pi)
                     (abs (- (vlax-curve-getendparam ent) (vlax-curve-getstartparam ent)))
                  )
               )
     )
     (while (< di1 di2)
       (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)
             der (distance '(0.0 0.0)
                           (vlax-curve-getsecondderiv ent (vlax-curve-getparamatdist ent di1))
                 )
             di1 (+ di1 (/ di3 (1+ (fix (/ 35.0 (/ di3 der (+ pi pi)))))))
       )
     )
     (if (vlax-curve-isclosed ent)
       lst
       (cons (vlax-curve-getendpoint ent) lst)
     )
    )
    ((eq (cdr (assoc 0 elst)) "SPLINE")
     (setq di1 (vlax-curve-getdistatparam ent (vlax-curve-getstartparam ent))
           di2 (vlax-curve-getdistatparam ent (vlax-curve-getendparam ent))
           inc (/ di2 25.0)
     )
     (while (< di1 di2)
       (setq lst (cons (vlax-curve-getpointatdist ent di1) lst)

             di1 (+ di1 inc)
       )
     )
     (if (vlax-curve-isclosed ent)
       lst
       (cons (vlax-curve-getendpoint ent) lst)
     )
    )
  )
)
;;亮显块内线圆
(defun C:w1 (/ E EN PTS X Y)
  (setq en (nentsel))
  (setq pts (LM:Entity->PointList (car en)))
  (setq e (car (cadddr en)))       ;块  
  (vl-cmdf "_.ucs" "_OB" e)        ;wcs
  (setq pts (mapcar '(lambda (x) (trans x 1 0)) pts))     ;ucs
  (vl-cmdf "_.ucs" "_p")        ;恢复ucs
  (setq pts (mapcar '(lambda (x) (trans x 0 1)) pts))
  (mapcar '(lambda (x y) (GRDRAW x y 1)) pts (cdr pts))
)

lucas3

请问长老，这个有什么具体用处？

/db_自贡黄明儒_

写来耍的。至于用处，每个人可能看法不同

ysq101

原来处理块内的程序这么难啊。。。

434939575

大师，我想写个统计块内图元的。没找到方向！您有类似的没有？谢谢！