帮忙把这个程式修改下
命令：ADS当前只标注R，麻烦大家帮忙修改下让其也能标注圆，另外可否在其注释后面增加其数量?不胜感谢。
完了，没人理，自己顶。 回复 killyouldc 的帖子
在其中一个函数加了几句，看达得到你的要求不？
(defun c:ads( / SSLIST SSLEN ID ENT_CLASS CP R SA EA SP EP ENTDT ENTD BULGE mp agle DD TT M TEMP TZ oos pt)
(SETQ OOS(GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(setq sslist (ssget '((-4 . "<or") (0 . "CIRCLE") (0 . "ARC") (0 . "LWPOLYLINE") (-4 . "or>"))))
(setq sslen (sslength sslist)
NUM_PT 0
NUM_ENT 0
NUm_ARCTYPE 0)
(setq dd (strcat (strcat "默认圆半径<" (rtos UNSPEC 2 3)) ">:"))
(setq tt (getdist dd))
(if (= nil tt) (setq tt UNSPEC)(setq UNSPEC tt ) )
(COMMAND"UCS" "W" "")
(SETQ FAC(GETVAR "DIMLFAC") TZ (GETVAR "TEXTSIZE"))
(setq id 0)
(repeat sslen
(SETQ ENTD(ENTGET(SSNAME SSLIST ID)))
(SETQ ENT_CLASS(CDR (ASSOC 0 ENTD)))
(COND
((= ENT_CLASS "ARC")
(PROGN
(setq cp (cdr (assoc 10 entd)))
(setq r (cdr (assoc 40 entd)))
(setq sa(cdr (assoc 50 entd)))
(setq ea(cdr (assoc 51 entd)))
(setq sp (polar cp sa r)
ep (polar cp ea r))
(SETQ TemP(ADD_ARCTYPE (* R FAC)))
(IF TEMP
(PROGN
(if (> sa ea)(setq ea (+ (* 2 pi) ea)))
(SETQ M(polar cp (/(+ ea sa)2)r) )
(COMMAND "TEXT" "J" "C" (POLAR M(angle m cp)TZ) "" "" TEMP )
)
)
))
((= ENT_CLASS "CIRCLE")
(PROGN
(setq cp (cdr (assoc 10 entd)))
(SETQ TemP(ADD_ARCTYPE (* R FAC)))
(IF TEMP
(PROGN
(COMMAND "TEXT" cp "" "" TEMP "")
)
)
))
((= ENT_CLASS "LWPOLYLINE")
(PROGN
(SETQ ENTDT ENTD)
(while (/= 10 (car (car entDT)))(setq entDT (cdr entDT)))
(while (/= nil (assoc 10 (cdr entDT)))
(setq sp (cdr(assoc 10 entDT)))
(setq bulge (cdr(assoc 42 entDT)))
(setq entDT(cddDDr entDT))
(setq ep (cdr(assoc 10 entDT)))
(IF (/= 0 BULGE)
(PROGN
(if (> 0 bulge) (progn (setq bulge(abs bulge)) (setq temp sp) (setq sp ep) (setq ep temp)))
(setq d (distance sp ep))
(setq h (/ (* bulge d) 2))
(setq r (+(/ h 2) (/ (* d d) (* 8 h))))
(setq mp (list (/ (+ (car sp) (car ep)) 2) (/ (+ (cadr sp) (cadr ep)) 2) 0))
(setq agle(- (angle ep sp) (/pi 2)))
(setq cp (polar mp agle (- r h)))
(setq sa (angle cp sp) ea (angle cp ep))
(SETQ TemP(ADD_ARCTYPE (* R FAC)))
(IF TEMP
(PROGN
(if (> sa ea)(setq ea (+ (* 2 pi) ea)))
(SETQ M(polar cp (/(+ ea sa)2)r) )
(COMMAND "TEXT" "J" "C" (POLAR M(angle m cp)TZ) "" "" TEMP )
)
)
));IF (= 0 BULGE)
);WHILE
(IF(OR(= (CDR(ASSOC 70 ENTD)) 1)(=(CDR(ASSOC 70 ENTD)) 129))
(PROGN
(SETQ SP (CDR(ASSOC 10 ENTDT))
BULGE(CDR(ASSOC 42 ENTDT))
EP(CDR(ASSOC 10 ENTD)))
(IF (/= 0 BULGE)
(PROGN
(if (> 0 bulge) (progn (setq bulge(abs bulge)) (setq temp sp) (setq sp ep) (setq ep temp)))
(setq d (distance sp ep))
(setq h (/ (* bulge d) 2))
(setq r (+(/ h 2) (/ (* d d) (* 8 h))))
(setq mp (list (/ (+ (car sp) (car ep)) 2) (/ (+ (cadr sp) (cadr ep)) 2) 0))
(setq agle(- (angle ep sp) (/pi 2)))
(setq cp (polar mp agle (- r h)))
(setq sa (angle cp sp) ea (angle cp ep))
(SETQ TemP(ADD_ARCTYPE (* R FAC)))
(IF TEMP
(PROGN
(if (> sa ea)(setq ea (+ (* 2 pi) ea)))
(SETQ M(polar cp (/(+ ea sa)2)r) )
(COMMAND "TEXT" "J" "C" (POLAR M(angle m cp)TZ) "" "" TEMP )
)
)
));IF (= 0 BULGE)
));IF(OR(= (CDR(ASSOC 70 ENTD)) 1)(=(CDR(ASSOC 70 ENTD)) 129))
))
);COND
(SETQ ID(1+ ID))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq pt (getpoint"Radiums informations to isert:"))
(command "text" pt "" "" (strcat "UNSPECIFIED R"(RTOS UNSPEC 2 3)))
(SETQ PT (LIST (CAR PT)(-(CADR PT)(* 1.4 TZ))))
(setq id 0)
(repeat num_arctype
(command "text" (list (car pt)(- (cadr pt)(* id (* 1.4 tz)))) "" ""
(strcat (CAdR(EVAL(READ (STRCAT "ARCTYPE"(ITOA ID))))) " : R"
(rtos (CAR(EVAL(READ (STRCAT "ARCTYPE"(ITOA ID))))) 2 3))
)
(setq id(1+ id))
)
(setvar "osmode" oos)
) yarp 发表于 2011-6-19 15:03 static/image/common/back.gif
回复 killyouldc 的帖子
在其中一个函数加了几句，看达得到你的要求不？
能标圆了，可是标圆的话标出来的结果是错误的，大哥能抽点时间再修改下好吗？
页:
[1]