프로그램
캐드 분류

리습 수정이 필요해요 ㅜㅜ(수정

컨텐츠 정보

  • 191 조회
  • 4 댓글
  • 0 추천
  • 0 비추천
  • 목록

본문

(defun c:pipi (/ AcDoc oSpace Lts Vgap Hgap ss p1 p2 SsObjList LayerSame_ObjList
                LaLenList LaLenList1 MaxLen1 MaxLen2 Table)
  (vl-load-com)
  (setq AcDoc (vla-get-activedocument (vlax-get-acad-object)))
  (cond
    ((= (vla-get-activespace AcDoc) 1) (setq oSpace (vla-get-modelspace AcDoc)))
    ((= (vla-get-activespace AcDoc) 0) (setq oSpace (vla-get-paperspace AcDoc)))
  )
 
  (defun Haru_ssToObjList ( ss / k ObjList)
    (repeat (setq k (sslength ss))
      (setq ObjList (cons (vlax-ename->vla-object (ssname ss (setq k (1- k)))) ObjList))
    )
    ObjList
  )
 
  (defun Haru_LayerSameList(L)
    (if L
      (cons
        (vl-remove-if-not '(lambda (a) (= (vla-get-Layer (car L)) (vla-get-Layer a))) L)
        (Haru_LayerSameList (vl-remove-if '(lambda (a) (= (vla-get-Layer (car L)) (vla-get-Layer a))) L))
      )
    )
  )
 
  (defun Sub_Comma(txt / Citem Btxt txt k comp Ntext)
    (if (setq Citem (vl-string-position (ascii ".") txt))
      (progn
        (setq Btxt (substr txt (1+ Citem) (- (strlen txt) Citem)))
        (setq txt (substr txt 1 Citem))
      )
      (setq Btxt "")
    )
    (setq k (strlen txt) comp 0 Ntext "")
    (repeat k
      (setq item (substr txt k 1))
       (if (<=  48 (ascii item) 57)
        (setq comp (+ comp 1))
        (setq comp 0)
      )
      (if (= comp 4) (setq Ntext (strcat "," Ntext) comp 1) )
      (setq Ntext (strcat item Ntext))
      (setq k (- k 1))
    )
    (setq Ntext (strcat Ntext Btxt))
    Ntext
  )
 
 
  (setq Lts (getvar "ltscale"))
  ;(setq @#Texhight (* Lts 5.0))
  (setq LaLenList1 '())
 
  (or @#Texhight (setq @#Texhight 20))
  (setq @#Texhight(cond((getreal(strcat  "n테이블 문자크기입력:<"(rtos @#Texhight 2 2)">")))(@#Texhight)))
 
  (setq Vgap 4 Hgap 4)
 
  (and
    (setq ss (ssget (list (cons 0 "LINE,LWPOLYLINE,CIRCLE,ARC,SPLINE,ELLIPSE"))))
    (setq p1 (getpoint "n삽입점:"))
    (progn
      (setq SsObjList (Haru_ssToObjList ss))
      (setq LayerSame_ObjList  (Haru_LayerSameList SsObjList))
  
(setq LaLenList
 (mapcar
  '(lambda (a)
   (list
    (vla-get-Layer (car a))
    (apply '+
     (mapcar
      '(lambda (b)
       (vlax-curve-GetDistAtParam b (vlax-curve-getEndParam b))
      )
      a
     )
    )
    (vl-list-length a)
   )
  )
  LayerSame_ObjList
 )
)
    )
  )
  (setq MaxLen1 (apply 'max
                    (mapcar '(lambda (a) (car (cadr (textbox (list (cons 1 (car a)) (cons 40 @#Texhight)))))) LaLenList)
                  )
  )
  (setq MaxLen2 (apply 'max
                    (mapcar '(lambda (a) (car (cadr (textbox (list (cons 1 (rtos (cadr a) 2 2)) (cons 40 @#Texhight)))))) LaLenList)
                  )
  )
 
  (setq LaLenList1(vl-sort LaLenList(function (lambda (x1 x2) (> (car x1) (car x2))))))
 
  (setq Table (vlax-invoke oSpace 'AddTable p1 (+ 2 (length LaLenList1)) 3 (* @#Texhight 2) (* 1.5 (max MaxLen1 MaxLen2))))
  (vla-put-horzcellmargin table (* @#Texhight 0.5))
  (vla-SetText Table 1 0 "PIPE")
  (vla-SetText Table 1 1 "M")
  (vla-SetText Table 1 2 "EA")
  (setq i 1)
  (mapcar '(lambda (a) (vla-SetText Table (setq i  (1+ i))  0 (car a)) (vla-SetCellAlignment Table i 0 acMiddleCenter)) LaLenList1)
  (setq i 1)
  (mapcar '(lambda (a) (vla-SetText Table (setq i  (1+ i))  1 (Sub_Comma (rtos (/ (cadr a) 1000.00) 2 2))) (vla-SetCellAlignment Table i 1 acMiddleRight)) LaLenList1)
  (setq i 1)
  (mapcar '(lambda (a) (vla-SetText Table (setq i  (1+ i))  2 (rtos (caddr a) 2 0)) (vla-SetCellAlignment Table i 2 acMiddleRight)) LaLenList1)
  (vlax-invoke Table 'SetTextheight acHeaderRow @#Texhight)
  (vlax-invoke Table 'SetTextHeight acDataRow @#Texhight)
  (vla-deleterows Table 0 1)
(vl-cmdf "_Explode" (entlast))
(vl-cmdf "_Explode" (entlast))
  (princ)
)
이렇게 레이어 마다 선길이를 표로 보여주는 리습을 쓰고있는데요
이렇게 해서 쓰니 레이어이름이 40,32,25가있다면 표 제일 위는  40 > 32 >25 순으로 나오더라구요 
25 > 32 > 40 순으로 제가 원하는 순서로 표나오게 할수없나요??
메리크리스마스

관련자료

댓글 4 / 1 페이지

수야12님의 댓글

  (setq LaLenList1(vl-sort LaLenList(function (lambda (x1 x2) (> (car x1) (car x2))))))

이 부분 
전체 6,913 / 1 페이지
번호
제목
이름
알림 0