穿线孔的颜色优化

726613

程序如下：


功能：画穿线孔

(defun c:ae(/)
    (setq varosmode (getvar "OSMODE")) ;捕捉模式
    (setq varcmdecho (getvar "CMDECHO"))
    (setq varclayer (getvar "CLAYER"))
    (setvar "OSMODE" 0)
    (setvar "CMDECHO" 0)
    (princ "\n-->请选取穿线孔>=16圆对象:\n")  
    (setq ssentset (ssget))  
    (if        (/= ssentset nil)
        (progn (setq nent (sslength ssentset))
        (setq i 0)
        (repeat        nent (setq ssent (entget (ssname ssentset i)))  
    (if        (= "LWPOLYLINE" (cdr (assoc 0 ssent)))  
    (if        (= 1 (cdr (assoc 70 ssent)))
        (l01022p ssent))  
    (if        (= "CIRCLE" (cdr (assoc 0 ssent)))
        (l01022c ssent)))
        (setq i (1+ i)))))
    (setvar "OSMODE" varosmode)
    (setvar "CMDECHO" varcmdecho)
    (setvar "CLAYER" varclayer)

    (princ)
)

(defun l01022p (/)
    (setq strlayer (cdr (assoc 8 ssent)))  
    (setq numpt (cdr (assoc 90 ssent)))
    (setq tempssent (member (assoc 10 ssent) ssent))  
    (setq j1 0)  
    (setq listpt '())
      (while (< j1 numpt)  
        (setq listpt (append listpt (list (trans (cdr
          (nth (* j1 4) tempssent)) 0 1)) ))
        (setq j1 (1+ j1)) )
    (setq xmin (car (nth 0 listpt)))
    (setq xmax (car (nth 0 listpt)))
    (setq ymin (cadr (nth 0 listpt)))
    (setq ymax (cadr (nth 0 listpt)))
    (setq j2 0)
    (while (< j2 numpt)
        (if (> xmin (car (nth j2 listpt)))
            (setq xmin (car (nth j2 listpt))))
        (if (< xmax (car (nth j2 listpt)))
            (setq xmax (car (nth j2 listpt))))
        (if (> ymin (cadr (nth j2 listpt)))
            (setq ymin (cadr (nth j2 listpt))))
        (if (< ymax (cadr (nth j2 listpt)))
            (setq ymax (cadr (nth j2 listpt))))
          (setq j2 (1+ j2)))
       (if (or (>= (- ymax ymin) 8) (>= (- xmax xmin) 8))
        (l01022p01 tempssent listpt 1))
)

(defun l01022c (ssent / strlayer pt pt1 radius)
        (setq strlayer (cdr (assoc 8 ssent)))
        (setvar "CLAYER" strlayer)
        (setq radius (cdr (assoc 40 ssent)))
        (if (>= radius 3) (progn
            (setq pt (cdr (assoc 10 ssent)))
            (setq pt (trans pt 0 1))  
            (setq pt1 (polar pt (* 0.25 pi) (- radius 4)))
        (if (>= radius 8) (progn
            (setq blkname "ae.dwg")
  (command "insert" blkname  pt1 1 1 0)))))
)

(defun l01022p01 ()
        (setq numpt (length listpt))
        (setq j3 0)
        (setq numlen '())
        (while (< j3 numpt)
            (if        (= 0 (cdr (nth (+ 3 (* 4 j3)) ssent)))
            (progn
                (setq startpt (nth j3 listpt))
                (setq endpt (nth (rem (1+ j3) numpt) listpt))
                (setq dist (distance startpt endpt))
                (setq numlen (append numlen (list (list j3 dist))))
                ))
            (setq j3 (1+ j3)))
           (if        (/= (setq len (length numlen)) 0)   
                (progn
                (setq j4 0)
                  (while (< j4 len)
                     (setq tmplist1 (nth j4 numlen))
                     (setq k1 0)
                     (while (< k1 len)
                     (setq tmplist2 (nth k1 numlen))
                     (if (> (cadr tmplist1) (cadr tmplist2))
                        (progn
                         (setq numlen (subst '() tmplist1 numlen))
                         (setq numlen (subst tmplist1 tmplist2 numlen))
                         (setq numlen (subst tmplist2 '() numlen))
                         (setq tmplist1 (nth j4 numlen)) ))
                         (setq k1 (1+ k1)))
                         (setq j4 (1+ j4)))
                )
        )
        (if (/= numlen nil)
            (progn
              (setq m 0)
              (setq ispt 0)
              (while (and (< m (length numlen)) (= ispt 0))
              (setq ispt (l01022i m numlen))
              (setq m (1+ m)) )
        (if (= ispt 1)
           (command "CIRCLE" cxkpt 1)
    )))
)

(defun l01022i (/)
        (setq ptno (car (nth m numlen)))
        (setq startpt (nth ptno listpt))
        (setq endpt (nth (rem (1+ ptno) numpt) listpt))
        (setq        midpt (list (/ (+ (car startpt) (car endpt)) 2.0)
        (/ (+ (cadr startpt) (cadr endpt)) 2.0)))       
        (setq lrad (angle startpt endpt))

        (setq j5 0)
        (command "AREA")
        (while (< j5 numpt)
                (command (nth j5 listpt))
                (setq j5 (1+ j5)))(command "")
        (setq entarea (getvar "AREA"))
        (setq crad (+ lrad (* pi 0.5)))
        (setq tmppt (polar midpt crad 0.1))
        (setq j6 0)
        (command "AREA")
        (while (<= j6 ptno)
                (command (nth j6 listpt))
                (setq j6 (1+ j6)))
        (command tmppt)
        (while (< j6 numpt)
                (command (nth j6 listpt))
                (setq j6 (1+ j6)))(command "")
        (setq ptarea (getvar "AREA"))
        (if (> ptarea entarea)
           (setq crad (+ crad pi)))
        (if (= flag 0)
            (progn (setq crad (+ crad pi))
                    (setq cxkpt (polar midpt crad 4))
                    (setq nflag 1) nflag)
             (progn (setq cxkpt (polar midpt crad 4))
                    (setq j7 0) (setq k2 0)
                    (while (< j7 (length listpt))
         (if (/= (inters cxkpt (list (car cxkpt) (- ymin 0.5))
             (nth j7 listpt) (nth (rem (1+ j7) (length listpt)) listpt)) nil)
              (setq k2 (1+ k2)))
              (setq j7 (1+ j7)))
                (if (= (rem k2 2) 1)
                   (progn
                        (setq nflag 1)
                        (setq k3 0)
                     (while (< k3 numpt)
                        (setq spt (nth k3 listpt))
                        (setq ept (nth (rem (1+ k3) numpt) listpt))
                        (setq ang1 (angle spt ept))
                        (setq ang2 (+ (* 0.5 pi) ang1))
                        (setq pt1 (polar cxkpt ang2 0.1))
                        (setq mpt (inters spt ept cxkpt pt1 nil))
                        (setq d2 (distance cxkpt mpt))
                (if (< d2 3.999)

        (progn
           (setq d1 (sqrt (- (* 4 4) (* d2 d2))))
        (setq pt2 (polar mpt ang1 d1))
        (setq pt3 (polar mpt (+ ang1 pi) d1))
        (setq y23min (min   (cadr pt2)  (cadr pt3) ))
        (setq x23min (min   (car pt2)   (car pt3)  ))
        (setq y23max (max   (cadr pt2)  (cadr pt3) ))
        (setq x23max (max   (car pt2)   (car pt3)  ))
          (if  (not  (or  
                 (and (>  (car ept)   x23max)
                      (>  (cadr ept)  y23max)
                      (>  (car spt)   x23max)
                      (>  (cadr spt)  y23max))
                 (and (<  (car ept)   x23min)
                      (<  (cadr ept)  y23min)
                      (<  (car spt)   x23min)
                      (<  (cadr spt)  y23min))
                (and  (<  (car ept)   x23min)
                      (>  (cadr ept)  y23max)
                      (<  (car spt)   x23min)
                      (>  (cadr spt)  y23max))
                (and  (>  (car ept)   x23max)
                      (<  (cadr ept)  y23min)
                      (>  (car spt)   x23max)
                      (<  (cadr spt)  y23min))))
        (setq nflag 0))))
        (setq k3 (1+ k3))))
        (setq nflag 0)) nflag))
)

sanji14

你好，方形孔好像不行。