프로그램
캐드 분류

리습 수정 검토 요청

컨텐츠 정보

  • 231 조회
  • 2 댓글
  • 0 추천
  • 0 비추천
  • 목록

본문

안녕하세요 

원과 사각형의 센타선 생성되는 리습인데요
센타선 생성시 '0' 번 레이어에 적색으로 센타선으로 나타나게 수정 좀 부탁 드립니다.
;;********** *****************************************************************
;;* [CENTER LINE] CIRCLE/OPENING/X-LINE/CROSS/HOLE/BAND CROSS                *
;;* 1999/12/8                                              By K.W.Park       *
;;****************************************************************************
(defun xlin_er (s)
 (if (/= s "Function Cancelled")
 (if (= s "quit / exit abort")
  (princ)
  (princ (strcat "nERROR:" s))
 )
 )
 (setvar "osmode" oosmo)
 (setvar "gridmode" sgrid)
 (command "regen") 
 (setvar "highlight" ohig) 
 (setvar "ucsicon" oucn) 
 (command "ucs" "p") 
 (setvar "ucsfollow" sucsf)
 (setvar "cmdecho" ocmde)  
 (setq *error* olderr)
 (princ)
)
(defun dtr (dtr1)
(* pi (/ dtr1 180.00))
)
;——————————————————————–
(defun c:CX (/ tb1 an1 op p3 p4 p5 p6 p7 p8 e1 e2 p10 ocmde ooth ohig
               e3 e4 e5 e6 dih len olderr ol po ooth tb2 p9 ang dis
               po1 pt1 pt2 ag2 ag3 di ag1 ag4 pk p1 p2 t1 t2 thk cen
               d es rad sucsf oucn sgrid p11 deg f f10 f11 fl hd p1k
               pf pk1 px py s s10 s11 sl ohig ds1 ds2 ds3 pc pe1 ans
               py1 py2 py3 py4 br sd sl cd ow pt id1 id2 ent1 ent2 hl
      tl ttl p1 pt pc elast oucn oosmo plist)
 (command "undo" "be") 
 (setq olderr *error* *error* xlin_er)
 (setq ocmde (getvar "cmdecho"))
 (setq ooth (getvar "orthomode"))
 (setq ohig (getvar "highlight")) 
 (setq oucn (getvar "ucsicon"))
 (setq oosmo (getvar "osmode"))
 (setq sgrid (getvar "gridmode"))
 (setq sucsf (getvar "ucsfollow")) 
 (setvar "cmdecho" 0)
 (setvar "ucsicon" 2)
 (setvar "highlight" 1) 
 (setq tb1 (tblsearch "LAYER" "cen-m"))
  (if (= tb1 nil)
   (command "layer" "n" "cen-m" "c" 6 "cen-m" "lt" "center2″ "cen-m" "")
  )
;—————————————————————————————————–
 (setq an1 (strcase (getstring "n  : ")))
;—————————————————————————————————–
(if (or (= an1 "C") (= an1 ""))
 (progn
  (while an1
   (command "ucs" "")   
   (setvar "gridmode" 0)   
   (setvar "ucsfollow" 0)   
   (setq es (entsel "nSelect arc or circle: "))
    (if es
      (progn
       (setq es (car es))
       (redraw es 3)
        (if (and
          (/= (cdr (assoc 0 (entget es))) "ARC")
          (/= (cdr (assoc 0 (entget es))) "CIRCLE")
          )
         (progn (prompt "nentity is a ")
                (princ (cdr (assoc 0 (entget es))))
                (setq es nil)
         )
        )
      )
         (exit) 
    )
   (command "ucs" "e" es) 
   (setq cen (trans (cdr (assoc 10 (entget es))) es 1))
   (setq rad (cdr (assoc 40 (entget es))))
   (prompt "nRadius is ")
   (princ (rtos rad))
   (initget 6 "D")
   (setvar "orthomode" 1)  
   (setq d (getdist "nDrag/ : "))
    (if (= d nil) (progn (redraw es 4) (setq d "D")))
    (if (= d "D")
     (progn
      (command "osnap" "non") 
      (initget 7)
      (setq d (getdist cen "nPoint out of circle: "))
     )
     (setq d (+ rad d))
    )
    (command "osnap" "non")
    (command "line" (list (car cen) (- (cadr cen) d) (caddr cen))
                    (list (car cen) (+ (cadr cen) d) (caddr cen))
                    ""
    )
    (command "change" "l" "" "p" "la" "cen-m" "")
    (command "line" (list (- (car cen) d) (cadr cen) (caddr cen))
                    (list (+ (car cen) d) (cadr cen) (caddr cen))
                    ""
    )
    (command "change" "l" "" "p" "la" "cen-m" "")    
    (command "ucs" "p")
    (command "regen") 
   )    
  )
 ) ;endif – center
;————————————————–
(if (= an1 "X")   
 (progn  
   (setq fl (entget (car (entsel "nSelect upper(low) line:"))))  
   (setq pf (cdr (assoc 0 fl)))   
    (if (or (= pf "LWPOLYLINE") (= pf "POLYLINE"))
     (progn      
      (mapcar '(lambda (x) (if (= 10 (car x)) 
      (setq plist (append plist (list (cdr x))) ) ) ) fl) ;4 corners list
      (setq pk  (nth 0 plist));1stp
      (setq pk1 (nth 1 plist));2ndp
      (setq p1  (nth 2 plist));3rdp
      (setq p1k (nth 3 plist));4thp
     )
    );lwpolyline
  (if (= pf "LINE") 
  (progn   
   (setq f10 (cdr (assoc 10 fl)))
   (setq f11 (cdr (assoc 11 fl)))
    (if (> (car f10) (car f11))
     (progn 
      (setq pk f10)
      (setq pk1 f11)
     )       
     (progn            
      (setq pk f11)
      (setq pk1 f10)
     )
    )
   (setq sl (entget (car (entsel "nSelect low(upper) line:"))))  
   (setq s10 (cdr (assoc 10 sl)))
   (setq s11 (cdr (assoc 11 sl)))
    (if (> (car s10) (car s11))
     (progn 
      (setq p1 s11)
      (setq p1k s10)
     )
     (progn 
      (setq p1 s10)
      (setq p1k s11)
     )
    )
   )
  ) ;line
   (command "osnap" "non")
   (command "line" pk p1 "")    (setq e1 (entlast))
   (command "line" pk1 p1k "")  (setq e2 (entlast))
   (command "chprop" e1 e2 "" "la" "cen-m" "")  
 ) 
) ;end if – x center line
;—————————————————-
 (if (= an1 "CR") 
  (progn   
   (setq f (car (entsel "nSelect upper(low) line:")))
   (setq fl (entget f))
   (setq gf (grread t))
   (setq gf1 (car (cdr gf)))
   (setq pf (cdr (assoc 0 fl)))  
    (if (or (= pf "LWPOLYLINE") (= pf "POLYLINE"))
     (progn
      (princ (strcat "nobjet is " pf))
      (command "explode" f)      
      (setq sss (ssget gf1))
      (setq e1f (ssname sss 0))
      (setq fl (entget e1f))
      (command "undo" 1)
     )
    )
   (setq f10 (cdr (assoc 10 fl)))
   (setq f11 (cdr (assoc 11 fl)))
    (if (> (car f10) (car f11))
     (progn 
      (setq pk f10)
      (setq pk1 f11)
     )       
     (progn            
      (setq pk f11)
      (setq pk1 f10)
     )
    )
   (setq s (car (entsel "nSelect low(upper) line:")))
   (setq sl (entget s))
   (setq gs (grread t))
   (setq gs1 (car (cdr gs)))  
   (setq pf1 (cdr (assoc 0 sl)))  
   (if (or (= pf1 "LWPOLYLINE") (= pf1 "POLYLINE"))
      (progn
       (command "explode" s)     
       (setq kkk (ssget gs1))
       (setq e2f (ssname kkk 0))
       (setq sl (entget e2f))       
      ) 
    );if 2nd polyline     
    (setq s10 (cdr (assoc 10 sl)))
    (setq s11 (cdr (assoc 11 sl)))
    (if (> (car s10) (car s11))
     (progn 
      (setq p1 s11)
      (setq p1k s10)
     )
     (progn 
      (setq p1 s10)
      (setq p1k s11)
     )
    )
   (setq ds1 (distance pk p1)
         ag1 (angle pk p1)
          pc (polar pk ag1 (/ ds1 2)) ;center
         ag2 (angle pk pk1)
         ag4 (angle pk1 pk)
         ds2 (distance pk pk1)
         ds3 (distance pk1 p1)
         pe1 (polar p1 ag4 (/ ds2 2)))    
   (setvar "orthomode" 1)  
   (princ "nDrag or Length: ")
   (command "osnap" "non")
   (command "line" pe1 "\" "") (setq e3 (entlast))
   (setq t1 (entget e3)
        py1 (cdr (assoc 11 t1))                 ;line 1
        len (distance pe1 py1) 
        ag3 (angle py1 pe1))
   (setq py2 (polar py1 ag3 (+ (* len 2) ds3))  ;line 2
         py3 (polar pc ag2 (+ (/ ds2 2) len))   ;line 3
         py4 (polar pc ag4 (+ (/ ds2 2) len)))  ;line 4
   (command "erase" e3 "")    
   (command "line" py1 py2 "")    (setq e1 (entlast))
   (command "line" py3 py4 "")    (setq e2 (entlast))
   (command "chprop" e1 e2 "" "la" "cen-m" "")
   (setvar "osmode" oosmo) 
 ) 
) ;end if – cross center line
;—————————————————–
(if (= an1 "S")
 (progn 
   (setvar "orthomode" 1)
   (setq pk (getpoint "nstart point: "))
   (setq p1 (getpoint pk "nsecond point: "))   
   (setq dis (distance pk p1) 
         ag1 (angle pk p1))  
   (setq pc (polar pk ag1 (/ dis 2.0)))
   (command "osnap" "non") 
   (command "line" pc "\" "")  (setq e1 (entlast)) 
   (setq p2 (cdr (assoc 11 (entget e1)))
        len (distance p2 pc)
        ag2 (angle p2 pc))   
   (command "erase" e1 "")
   (setq p3 (polar p2 ag2 (* len 2.0)))
    (if (= p1 nil)
      (setq p2 p1)
    )  
   (command "line" p2 p3 "")    (setq e2 (entlast));cen line
   (command "chprop" e2 "" "la" "cen-m" "")
   (princ (strcat "nobject length: " (rtos dis) " (half: " (rtos (/ dis 2.0)) ")" ))
 ) 
)  ;end if -single
;—————————————————
 (command "undo" "e")  
 (command "redraw")
 (setvar "highlight" ohig)  
 (setvar "ucsicon" oucn)  
 (setvar "osmode" oosmo)
 (setvar "orthomode" ooth)
 (setvar "cmdecho" ocmde)
 (setvar "ucsfollow" sucsf)
 (setvar "gridmode" sgrid)  
 (setq *error* olderr) 
 (princ)
)
;;;;;;;;;;
(princ "ntCENTER [Circle/Open/X/Cross/Line/cross] : 1999.12.  by K.W.PARK")
(princ)                                               

관련자료

댓글 2 / 1 페이지

상큼메론90님의 댓글

emoticon

리습 내용이   기 ~~~~~~~~~~~~~~ 네요.

레이어 0번으로 센터선으로 1번색으로

;;********** ***************************************************************** ;;* [CENTER LINE] CIRCLE/OPENING/X-LINE/CROSS/HOLE/BAND CROSS                * ;;* 1999/12/8                                              By K.W.Park       * ;;**************************************************************************** (defun xlin_er (s)  (if (/= s "Function Cancelled")  (if (= s "quit / exit abort")   (princ)   (princ (strcat "nERROR:" s))  )  )  (setvar "osmode" oosmo)  (setvar "gridmode" sgrid)  (command "regen")  (setvar "highlight" ohig)  (setvar "ucsicon" oucn)  (command "ucs" "p")  (setvar "ucsfollow" sucsf)  (setvar "cmdecho" ocmde)   (setq *error* olderr)  (princ) ) (defun dtr (dtr1) (* pi (/ dtr1 180.00)) ) ;——————————————————————– (defun c:CX (/ tb1 an1 op p3 p4 p5 p6 p7 p8 e1 e2 p10 ocmde ooth ohig                e3 e4 e5 e6 dih len olderr ol po ooth tb2 p9 ang dis                po1 pt1 pt2 ag2 ag3 di ag1 ag4 pk p1 p2 t1 t2 thk cen                d es rad sucsf oucn sgrid p11 deg f f10 f11 fl hd p1k                pf pk1 px py s s10 s11 sl ohig ds1 ds2 ds3 pc pe1 ans                py1 py2 py3 py4 br sd sl cd ow pt id1 id2 ent1 ent2 hl        tl ttl p1 pt pc elast oucn oosmo plist)  (command "undo" "be")  (setq olderr *error* *error* xlin_er)  (setq ocmde (getvar "cmdecho"))  (setq ooth (getvar "orthomode"))  (setq ohig (getvar "highlight"))  (setq oucn (getvar "ucsicon"))  (setq oosmo (getvar "osmode"))  (setq sgrid (getvar "gridmode"))  (setq sucsf (getvar "ucsfollow"))  (setvar "cmdecho" 0)  (setvar "ucsicon" 2)  (setvar "highlight" 1)  ;(setq tb1 (tblsearch "LAYER" "cen-m"))  ; (if (= tb1 nil)  ;  (command "layer" "n" "cen-m" "c" 6 "cen-m" "lt" "center2″ "cen-m" "")  ; ) ;—————————————————————————————————–  (setq an1 (strcase (getstring "n  : "))) ;—————————————————————————————————– (if (or (= an1 "C") (= an1 ""))  (progn   (while an1    (command "ucs" "")      (setvar "gridmode" 0)      (setvar "ucsfollow" 0)      (setq es (entsel "nSelect arc or circle: "))     (if es       (progn        (setq es (car es))        (redraw es 3)         (if (and           (/= (cdr (assoc 0 (entget es))) "ARC")           (/= (cdr (assoc 0 (entget es))) "CIRCLE")           )          (progn (prompt "nentity is a ")                 (princ (cdr (assoc 0 (entget es))))                 (setq es nil)          )         )       )          (exit)     )    (command "ucs" "e" es)    (setq cen (trans (cdr (assoc 10 (entget es))) es 1))    (setq rad (cdr (assoc 40 (entget es))))    (prompt "nRadius is ")    (princ (rtos rad))    (initget 6 "D")    (setvar "orthomode" 1)     (setq d (getdist "nDrag/ : "))     (if (= d nil) (progn (redraw es 4) (setq d "D")))     (if (= d "D")      (progn       (command "osnap" "non")       (initget 7)       (setq d (getdist cen "nPoint out of circle: "))      )      (setq d (+ rad d))     )     (command "osnap" "non")     (command "line" (list (car cen) (- (cadr cen) d) (caddr cen))                     (list (car cen) (+ (cadr cen) d) (caddr cen))                     ""     )     (command "change" "l" "" "p" "la" "0″ "c" "1″ "lt" "center" "")     (command "line" (list (- (car cen) d) (cadr cen) (caddr cen))                     (list (+ (car cen) d) (cadr cen) (caddr cen))                     ""     )     (command "change" "l" "" "p" "la" "0″ "c" "1″ "lt" "center" "")        (command "ucs" "p")     (command "regen")    )      )  ) ;endif – center ;————————————————– (if (= an1 "X")    (progn     (setq fl (entget (car (entsel "nSelect upper(low) line:"))))     (setq pf (cdr (assoc 0 fl)))       (if (or (= pf "LWPOLYLINE") (= pf "POLYLINE"))      (progn              (mapcar '(lambda (x) (if (= 10 (car x))       (setq plist (append plist (list (cdr x))) ) ) ) fl) ;4 corners list       (setq pk  (nth 0 plist));1stp       (setq pk1 (nth 1 plist));2ndp       (setq p1  (nth 2 plist));3rdp       (setq p1k (nth 3 plist));4thp      )     );lwpolyline   (if (= pf "LINE")   (progn      (setq f10 (cdr (assoc 10 fl)))    (setq f11 (cdr (assoc 11 fl)))     (if (> (car f10) (car f11))      (progn       (setq pk f10)       (setq pk1 f11)      )            (progn                  (setq pk f11)       (setq pk1 f10)      )     )    (setq sl (entget (car (entsel "nSelect low(upper) line:"))))     (setq s10 (cdr (assoc 10 sl)))    (setq s11 (cdr (assoc 11 sl)))     (if (> (car s10) (car s11))      (progn       (setq p1 s11)       (setq p1k s10)      )      (progn       (setq p1 s10)       (setq p1k s11)      )     )    )   ) ;line    (command "osnap" "non")    (command "line" pk p1 "")    (setq e1 (entlast))    (command "line" pk1 p1k "")  (setq e2 (entlast))    (command "chprop" e1 e2 "" "la" "0″ "c" "1″ "lt" "center" "")  )   ) ;end if – x center line ;—————————————————-  (if (= an1 "CR")   (progn      (setq f (car (entsel "nSelect upper(low) line:")))    (setq fl (entget f))    (setq gf (grread t))    (setq gf1 (car (cdr gf)))    (setq pf (cdr (assoc 0 fl)))      (if (or (= pf "LWPOLYLINE") (= pf "POLYLINE"))      (progn       (princ (strcat "nobjet is " pf))       (command "explode" f)            (setq sss (ssget gf1))       (setq e1f (ssname sss 0))       (setq fl (entget e1f))       (command "undo" 1)      )     )    (setq f10 (cdr (assoc 10 fl)))    (setq f11 (cdr (assoc 11 fl)))     (if (> (car f10) (car f11))      (progn       (setq pk f10)       (setq pk1 f11)      )            (progn                  (setq pk f11)       (setq pk1 f10)      )     )    (setq s (car (entsel "nSelect low(upper) line:")))    (setq sl (entget s))    (setq gs (grread t))    (setq gs1 (car (cdr gs)))     (setq pf1 (cdr (assoc 0 sl)))     (if (or (= pf1 "LWPOLYLINE") (= pf1 "POLYLINE"))       (progn        (command "explode" s)            (setq kkk (ssget gs1))        (setq e2f (ssname kkk 0))        (setq sl (entget e2f))             )     );if 2nd polyline         (setq s10 (cdr (assoc 10 sl)))     (setq s11 (cdr (assoc 11 sl)))     (if (> (car s10) (car s11))      (progn       (setq p1 s11)       (setq p1k s10)      )      (progn       (setq p1 s10)       (setq p1k s11)      )     )    (setq ds1 (distance pk p1)          ag1 (angle pk p1)           pc (polar pk ag1 (/ ds1 2)) ;center          ag2 (angle pk pk1)          ag4 (angle pk1 pk)          ds2 (distance pk pk1)          ds3 (distance pk1 p1)          pe1 (polar p1 ag4 (/ ds2 2)))       (setvar "orthomode" 1)     (princ "nDrag or Length: ")    (command "osnap" "non")    (command "line" pe1 "\" "") (setq e3 (entlast))    (setq t1 (entget e3)         py1 (cdr (assoc 11 t1))                 ;line 1         len (distance pe1 py1)         ag3 (angle py1 pe1))    (setq py2 (polar py1 ag3 (+ (* len 2) ds3))  ;line 2          py3 (polar pc ag2 (+ (/ ds2 2) len))   ;line 3          py4 (polar pc ag4 (+ (/ ds2 2) len)))  ;line 4    (command "erase" e3 "")       (command "line" py1 py2 "")    (setq e1 (entlast))    (command "line" py3 py4 "")    (setq e2 (entlast))    (command "chprop" e1 e2 "" "la" "0″ "c" "1″ "lt" "center" "")    (setvar "osmode" oosmo)  ) ) ;end if – cross center line ;—————————————————– (if (= an1 "S")  (progn    (setvar "orthomode" 1)    (setq pk (getpoint "nstart point: "))    (setq p1 (getpoint pk "nsecond point: "))      (setq dis (distance pk p1)          ag1 (angle pk p1))     (setq pc (polar pk ag1 (/ dis 2.0)))    (command "osnap" "non")    (command "line" pc "\" "")  (setq e1 (entlast))    (setq p2 (cdr (assoc 11 (entget e1)))         len (distance p2 pc)         ag2 (angle p2 pc))      (command "erase" e1 "")    (setq p3 (polar p2 ag2 (* len 2.0)))     (if (= p1 nil)       (setq p2 p1)     )     (command "line" p2 p3 "")    (setq e2 (entlast));cen line    (command "chprop" e2 "" "la" "0″ "c" "1″ "lt" "center" "")    (princ (strcat "nobject length: " (rtos dis) " (half: " (rtos (/ dis 2.0)) ")" ))  ) )  ;end if -single ;—————————————————  (command "undo" "e")   (command "redraw")  (setvar "highlight" ohig)   (setvar "ucsicon" oucn)   (setvar "osmode" oosmo)  (setvar "orthomode" ooth)  (setvar "cmdecho" ocmde)  (setvar "ucsfollow" sucsf)  (setvar "gridmode" sgrid)   (setq *error* olderr)  (princ) ) ;;;;;;;;;; (princ "ntCENTER [Circle/Open/X/Cross/Line/cross] : 1999.12.  by K.W.PARK") (princ)                          

;;;

전체 7,416 / 360 페이지
RSS
번호
제목
이름

최근글


새댓글


알림 0