프로그램
캐드 분류

리습 수정 부탁합니다. ㅜ.ㅜ

컨텐츠 정보

  • 661 조회
  • 1 댓글
  • 0 추천
  • 0 비추천
  • 목록

본문

길이 합계 리습인데

산출중 Text, Write 선택없이 그냥 바로 Text로 산출될수 있게 수정부탁합니다.
;;선택된 Line의 길이을 모두 더하는 명령(000822cho_i)
(defun c:lp(/  ss en n n1 k tot dis dis1 spt ept stype p2 pt r sosu
ename r old_elist old_f new_f new_elist )    
    
        (prompt "nCommand: Line Plus…")
        (prompt "n더하고자하는 line을 선택-> ")
        (setq ss (ssget))
        (setq n1 (sslength ss))
        (setq n n1 k 0)
        (setq tot 0 dis 0 dis1 0)
        
        (while (<= 1 n)
                (setq en (ssname ss k))
                (setq stype (cdr (assoc 0 (entget en))))
                (if (= stype "LINE")(progn
                        (setq spt (cdr (assoc 10 (entget en))))
                        (setq ept (cdr (assoc 11 (entget en))))
                        (setq dis1 (distance spt ept))
                        (setq dis (/ dis1 1))
                        
                ))
                (terpri)(if (= stype "LWPOLYLINE")(progn
                        (command "area" "e" en)
                        (setq dis1 (getvar "perimeter"))
                        (setq dis (/ dis1 1))
                        
                ))(terpri)
                (setq tot (+ tot dis))
                (setq n (- n 1))
                (setq k (+ k 1))
                
        )
        
        (prompt "총")(prin1 n1)(prompt "개의 라인…")(prompt " = ")(prin1 tot)
        
(if (> tot 0)
  (progn
(initget "Text Write")
(setq p2 (getkword " [Text/Write] :")) 
(setq sosu 2)
(cond
((= P2 "Text")
(setq ename (car (entsel))) ;텍스트 객체가져오기
(setq r (rtos tot 2 sosu)) ;텍스트값
(setq r (SSJR r))
(setq old_elist (entget ename))
(setq old_f (assoc 1 old_elist)) ;현재 텍스트 값
(setq new_f (cons 1 r)) ;바꿀 텍스트값
(setq new_elist (subst new_f old_f old_elist)) ;텍스트값 교체
(entmod new_elist) ;바꾼 텍스트값 재생성
)
((= P2 "Write")
(setq pt (getpoint "nPick point of text:"))
(setq r (rtos tot 2 sosu)) ;텍스트값
(setq r (SSJR r))
(command "TEXT" pt "" 0 r)
)
(T 
)
)
  )
)
        (princ)
)
(defun SSJR( txt / dot txt1 txt2)
        (if (> sosu 0)
                (progn 
                        (if (>= (atof txt) 1)
                                (progn
                                        (setq dot (strlen (rtos (atoi txt) 2 0)))
                                        (setq txt (atof txt))
                                        (repeat sosu (setq txt (* txt 10)))
                                        (setq txt (rtos txt 2 0))
                                        (setq txt1 (substr txt 1 dot) txt2 (substr txt (+ dot 1)))
                                        (setq txt (strcat txt1″."txt2))
                                )
                                (progn
                                        (setq dot 2)
                                        (setq txt (+ 1 (atof txt)))
                                        (repeat sosu (setq txt (* txt 10)))
                                        (setq txt (rtos txt 2 0))
                                        (setq txt2 (substr txt dot))
                                        (setq txt (strcat "0."txt2))
                                )
                        )
                )
(setq txt (rtos (atof txt) 2 0))
        )
)

관련자료

댓글 1 / 1 페이지
전체 7,698 / 365 페이지
RSS
번호
제목
이름

최근글


새댓글


알림 0