리습 제작요청건 입니다.(사례금지급)
리습 고수분들 도움 부탁드립니다.
몇가지 조건부 합산 리습을 만들고싶은데 제가 가지고있는 리습으로는 부족하기에 요청드립니다.
하기 리습을 보시고 적절히 수정이 가능하신분은 문자 부탁드립니다.
적당한 사례금 드리도록 하겠습니다. 수고하세요.
> 연락처 : 010-7322-7186(문자만 주세요)
필요사항
1. 객체 분리산출 - 도면상에 칫수가 개소마다 0.2*5, 0.1, 0.3, 0.6등등 이렇게 각각 표기될때
전체 드레그할경우 1.0+0.1+0.3+0.6=2.0으로 합산(표기)이 가능한 리습.
2. 객체 구분산출 - 도면상에 칫수가 개소마다 A0.2, A0.3, B0.5, C0.1, D0.5, B0.6으로 각각 표기될때
전체 드레그하여 A로 시작하는 칫수의 합산(표기)이 가능한 리습.ex) A0.5
3. 객체 구분산출 - 도면상에 칫수가 개소마다 A0.2, A0.3, B0.5, C0.1, D0.5, B0.6으로 각각 Color로
표기될때 전체 드레그하여 Color별 칫수의 합산(표기)이 가능한 리습.ex) A0.5
보유하고있는 리습(보완/수정이 필요함)
;------------------------------------------------------------
(defun c:sm (/ z ss sno no tno sum x entity etype num h pt
num1 eq_num num_leng)
;------------------------------------------------------------
(setvar "cmdecho" 0)
(prompt "nSelect Text: ")
(setq ss (ssget))
(setq sno (sslength ss))
(setq no 0)
(setq sum 0.0)
(setq tno 0)
(repeat sno
(setq x (ssname ss no))
(setq etype (cdr (assoc 0 (entget x))))
(if (= etype "TEXT")
(progn
(setq entity (entget x))
(setq num1 (cdr (assoc 1 entity)))
(setq num_leng (strlen num1))
(setq num (atof num1))
(setq index 1)
(setq eq_num nil)
(repeat num_leng
(setq eq_num (substr num1 index 1))
(if (= eq_num "=")
(setq num (atof (substr num1 (+ index 1) num_leng)))
)
(setq index (+ index 1))
)
(setq sum (+ sum num))
(setq tno (1+ tno))
)
)
(setq no (1+ no))
)
(setq tno (itoa tno))
(setq sum (rtos sum 2 1))
(princ "nAdding ")
(princ tno)
(princ " nTexts: ")
(princ "nThe Result is: ")
(princ sum)
(princ " ")
(princ "nDo You Want Write it into the DWG? <y> ")
(setq z (strcase (getstring)))
(if (or (= z "") (= z "Y"))
(progn
(setq pt (getpoint "nText Point: "))
(setq h (getvar "textsize"))
(prompt "nText Height: ")
(princ H)
(princ " : ")
(setq z (getdist))
(if z
(setq h z)
)
(command "text"
(setq z pt)
(setq z h)
(setq z 0.0)
(setq z sum)
)
)
)
(setvar "cmdecho" 1)
(setvar "blipmode" 0)
(prin1)
)
(defun c:+ (/ ktms kl ksl kaddn kaddn1 ktol kadn
c_txt c_txt1 c_txt2 ch_car ch_text)
(setq ktms (ssget))
(if ktms (progn
(setq ksl (sslength ktms) kl 0 kaddn 0)
(while (< kl ksl)
(setq ktol (entget (ssname ktms kl)))
(setq kaddn1 (cdr (assoc 1 ktol)))
(if (= (cdr (assoc 0 ktol)) "TEXT")
; (setq kaddn (sqrt (+ (expt kaddn 2) (expt (atof kaddn1) 2) )))
(setq kaddn (+ kaddn (atof kaddn1)))
)
(setq kl (+ kl 1))
)
))
(setq kadn (rtos kaddn 2 1))
(prompt "n================================")
(setq c_txt (ssget))
(setq c_txt1 (entget (ssname c_txt 0)))
(setq c_txt2 (assoc 1 c_txt1))
(setq ch_car (car (assoc 1 c_txt1)))
(setq ch_text (subst (cons ch_car kadn) c_txt2 c_txt1))
(entmod ch_text)
(princ)
);end_defun_+
;
(defun c:*(/ ktms kl ksl kaddn kaddn1 ktol kadn
c_txt c_txt1 c_txt2 ch_car ch_text)
(setq ktms (ssget))
(if ktms (progn
(setq ksl (sslength ktms) kl 0 kaddn 1)
(while (< kl ksl)
(setq ktol (entget (ssname ktms kl)))
(setq kaddn1 (cdr (assoc 1 ktol)))
(if (= (cdr (assoc 0 ktol)) "TEXT")
(setq kaddn (* kaddn (atof kaddn1)))
)
(setq kl (+ kl 1))
)
))
(setq kadn (rtos kaddn 2 2))
(prompt "n================================")
(setq c_txt (ssget))
(setq c_txt1 (entget (ssname c_txt 0)))
(setq c_txt2 (assoc 1 c_txt1))
(setq ch_car (car (assoc 1 c_txt1)))
(setq ch_text (subst (cons ch_car kadn) c_txt2 c_txt1))
(entmod ch_text)
(princ)
);end_defun_*
;
(defun c:ml (/ z ss sno no tno mul x entity etype num h pt)
(setvar "cmdecho" 0)
(prompt "nSelect Text: ")
(setq ss (ssget))
(setq sno (sslength ss))
(setq no 0)
(setq mul 1.0)
(setq tno 0)
(repeat sno
(setq x (ssname ss no))
(setq etype (cdr (assoc 0 (entget x))))
(if (= etype "TEXT")
(progn
(setq entity (entget x))
(setq num (cdr (assoc 1 entity)))
(setq num (atof num))
(setq mul (* mul num))
(setq tno (1+ tno))
)
)
(setq no (1+ no))
)
(setq tno (itoa tno))
(setq mul (rtos mul 2 2))
(princ "nMultiply ")
(princ tno)
(princ " nTexts: ")
(princ "nThe Result is: ")
(princ mul)
(princ " ")
(princ "nDo You Want Write it into the DWG? <y> ")
(setq z (strcase (getstring)))
(if (or (= z "") (= z "Y"))
(progn
(setq pt (getpoint "nText Point: "))
(setq h (getvar "textsize"))
(prompt "nText Height: ")
(princ H)
(princ " : ")
(setq z (getdist))
(if z
(setq h z)
)
(command "text"
(setq z pt)
(setq z h)
(setq z 0.0)
(setq z mul)
)
)
)
(setvar "cmdecho" 1)
(setvar "blipmode" 0)
(prin1)
)
(defun c:root (/ ktms kl ksl kaddn kaddn1 ktol kadn
c_txt c_txt1 c_txt2 ch_car ch_text)
(setq ktms (ssget))
(if ktms (progn
(setq ksl (sslength ktms) kl 0 kaddn 0)
(while (< kl ksl)
(setq ktol (entget (ssname ktms kl)))
(setq kaddn1 (cdr (assoc 1 ktol)))
(if (= (cdr (assoc 0 ktol)) "TEXT")
(setq kaddn (sqrt (+ (expt kaddn 2) (expt (atof kaddn1) 2) )))
; (setq kaddn (+ kaddn (atof kaddn1)))
)
(setq kl (+ kl 1))
)
))
(setq kadn (rtos kaddn 2 0))
(prompt "n================================")
(setq c_txt (ssget))
(setq c_txt1 (entget (ssname c_txt 0)))
(setq c_txt2 (assoc 1 c_txt1))
(setq ch_car (car (assoc 1 c_txt1)))
(setq ch_text (subst (cons ch_car kadn) c_txt2 c_txt1))
(entmod ch_text)
(princ)
);end_defun_root
;
번호 | 제목 | 작성자 | 작성일 | 조회 |
공지사항 |
[공지] 글꼴은행 - 캐드 글꼴 442종 압축 파일 NOTICE
gocad
|
2022.09.01
|
조회 24266
|
gocad | 2022.09.01 | 24266 |
13759 |
멀티플롯 프로그램을 업그레이드 해서 올립니다.
캐드플러스
|
2024.05.23
|
조회 55
|
캐드플러스 | 2024.05.23 | 55 |
13758 |
버스(대형 관광버스) 입면과 평면도(2D) 도면 찾습니다 (1)
이충화
|
2024.04.26
|
조회 111
|
이충화 | 2024.04.26 | 111 |
13757 |
캐드 2008 문의 (키젠)
김현승
|
2024.04.25
|
조회 112
|
김현승 | 2024.04.25 | 112 |
13756 |
나눔고딕체 공유좀 부탁드립니다..
H.H
|
2024.03.20
|
조회 161
|
H.H | 2024.03.20 | 161 |
13755 |
한전 맨홀도
송주현
|
2024.01.15
|
조회 207
|
송주현 | 2024.01.15 | 207 |
13754 |
pump 외형도 부탁드립니다
장동현
|
2024.01.08
|
조회 239
|
장동현 | 2024.01.08 | 239 |
13753 |
XCLIP된 블럭/외부참조 선택하는 리습
유리민
|
2023.11.24
|
조회 281
|
유리민 | 2023.11.24 | 281 |
13752 |
문자 수정시 등호(=) 이후 부터 수정가능한 리습 없을까요?ㅜㅜ
조상흠
|
2023.11.23
|
조회 179
|
조상흠 | 2023.11.23 | 179 |
13751 |
인벤터 알루미늄 프로파일 라이브러리 파일 요청드립니다. (2)
오뚜기진라면
|
2023.11.15
|
조회 382
|
오뚜기진라면 | 2023.11.15 | 382 |
13750 |
[캣츠 가설재] 다운로드 및 소개 자료
CATS_Developer
|
2023.10.25
|
조회 359
|
CATS_Developer | 2023.10.25 | 359 |
13749 |
괄호치수'
케이알
|
2023.10.25
|
조회 176
|
케이알 | 2023.10.25 | 176 |
13748 |
혹시 치수 자동 산출 리습을 만들 수 있을까요? (4)
이기영
|
2023.09.29
|
조회 623
|
이기영 | 2023.09.29 | 623 |
13747 |
두선사이 중심선 리습 수정가능할까요…? 요청리습 (5)
캐드플러스
|
2023.09.19
|
조회 640
|
캐드플러스 | 2023.09.19 | 640 |
13746 |
잔도교 또는 잔도길 관련 단면도면 요청드립니다
보칼리지
|
2023.09.15
|
조회 263
|
보칼리지 | 2023.09.15 | 263 |
13745 |
측량도면 성과심사시 격자에 좌표 넣는 리습 (1)
정원곤
|
2023.09.12
|
조회 387
|
정원곤 | 2023.09.12 | 387 |
13744 |
다중출력(멀티플롯)리습 프로그램 업그레이드 (5)
캐드플러스
|
2023.09.07
|
조회 935
|
캐드플러스 | 2023.09.07 | 935 |
13743 |
zw cad 담장 그려주는 리습 있으신분 계십니까??
한동민
|
2023.08.31
|
조회 426
|
한동민 | 2023.08.31 | 426 |
13742 |
석공사 Shop 일부 구할수 있나요?
작전제1참모
|
2023.07.28
|
조회 396
|
작전제1참모 | 2023.07.28 | 396 |
13741 |
MoeumT 폰트 있으신분 있나요 ㅠ?
미소
|
2023.07.14
|
조회 377
|
미소 | 2023.07.14 | 377 |
13740 |
사각형 여러개를 가로와세로 치수만 나오는 리습 요청드립니다.
이경재
|
2023.07.11
|
조회 476
|
이경재 | 2023.07.11 | 476 |