帮忙把这个程式修改下

killyouldc

命令：ADS
当前只标注R，麻烦大家帮忙修改下让其也能标注圆，另外可否在其注释后面增加其数量?不胜感谢。

killyouldc

完了，没人理，自己顶。

yarp

回复 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)
  
)

killyouldc

yarp 发表于 2011-6-19 15:03
回复 killyouldc 的帖子

在其中一个函数加了几句，看达得到你的要求不？

能标圆了，可是标圆的话标出来的结果是错误的，大哥能抽点时间再修改下好吗？