리습 제작요청건 입니다.(사례금지급)
리습 고수분들 도움 부탁드립니다.
몇가지 조건부 합산 리습을 만들고싶은데 제가 가지고있는 리습으로는 부족하기에 요청드립니다.
하기 리습을 보시고 적절히 수정이 가능하신분은 문자 부탁드립니다.
적당한 사례금 드리도록 하겠습니다. 수고하세요.
> 연락처 : 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
|
조회 21819
|
gocad | 2022.09.01 | 21819 |
3490 |
한옥 캐드파일 구합니다.
swooshin
|
2012.10.16
|
조회 283
|
swooshin | 2012.10.16 | 283 |
3489 |
컨테이너 관련 도면 구할 수 있을까요? (1)
퐁네프
|
2012.10.09
|
조회 366
|
퐁네프 | 2012.10.09 | 366 |
3488 |
pedit즉 라인이 하나로 묶음이 안되네요 (1)
야곱
|
2012.09.30
|
조회 324
|
야곱 | 2012.09.30 | 324 |
3487 |
수도설비기호?
kku000
|
2012.09.25
|
조회 200
|
kku000 | 2012.09.25 | 200 |
3486 |
공원 캐드도면 구합니다
alskxm
|
2012.09.17
|
조회 161
|
alskxm | 2012.09.17 | 161 |
3485 |
리습 제작요청건 입니다.(사례금지급)
후다인빠
|
2012.09.11
|
조회 582
|
후다인빠 | 2012.09.11 | 582 |
3484 |
폰트좀 구해주세요 ㅠㅠㅠ
배쟈
|
2012.08.02
|
조회 296
|
배쟈 | 2012.08.02 | 296 |
3483 |
cad 폰트 구해요
swt36
|
2012.08.02
|
조회 275
|
swt36 | 2012.08.02 | 275 |
3482 |
캐드의 용량을 줄여주는 프로그램(프리웨어)소개
anold88
|
2012.07.25
|
조회 825
|
anold88 | 2012.07.25 | 825 |
3481 |
다중도면 출력 SenPlot 64비트 마이그레이션 (2)
KMC캐드중수
|
2012.07.24
|
조회 1312
|
KMC캐드중수 | 2012.07.24 | 1312 |
3480 |
캐드의 단순반복작업을 처리하는 SenMacro 소개
KMC캐드중수
|
2012.07.20
|
조회 627
|
KMC캐드중수 | 2012.07.20 | 627 |
3479 |
cad폰트좀 부탁드립니다
asdeeeeee
|
2012.07.04
|
조회 320
|
asdeeeeee | 2012.07.04 | 320 |
3478 |
경기도 지형도 있으시면 보내주셍 ㅠ
비빔밥
|
2012.07.02
|
조회 192
|
비빔밥 | 2012.07.02 | 192 |
3477 |
cad 폰트(acderef.shx외) 구합니다
제이차
|
2012.06.28
|
조회 266
|
제이차 | 2012.06.28 | 266 |
3476 |
일본어폰트 구합니다.
pata
|
2012.06.20
|
조회 186
|
pata | 2012.06.20 | 186 |
3475 |
화성시 항측도 구해요 ㅠㅠ
apple1234
|
2012.06.17
|
조회 119
|
apple1234 | 2012.06.17 | 119 |
3474 |
cad 폰트좀 부탁 드려요..
애멘토
|
2012.06.16
|
조회 203
|
애멘토 | 2012.06.16 | 203 |
3473 |
폰트 구합니다. (고수님들 좀 도와주세요)
suri00
|
2012.06.15
|
조회 163
|
suri00 | 2012.06.15 | 163 |
3472 |
고수님들 cad 폰트좀 부탁드립니다. 2010 사용중입니다.
감자즈
|
2012.06.15
|
조회 155
|
감자즈 | 2012.06.15 | 155 |
3471 |
폰트 구해요~
센스홍
|
2012.06.06
|
조회 193
|
센스홍 | 2012.06.06 | 193 |