本帖最后由 Bao_lai 于 2018-10-21 13:13 编辑
 - (defun C:CALCU (/ ss ssl i e str el nstr p p1 ll l)
- ;(if (not (member "GEOMCAL.ARX" (MAPCAR ' strcase (arx)))) ;无用代码出错
- ; (arxload "geomcal.arx")
- ;)
-
- (setq csd (getint "\n请指定计算结果小数位精度:<2>"))
- (if (= csd nil)
- (setq csd 2)
- )
- (if (and (setq ss (ssget '((0 . "TEXT,TCH_TEXT"))))
- (setq p (getpoint "\n请输入标注点位置: "))
- )
- (progn
- (setq ssl (sslength ss)
- i -1
- )
- (command "cal")(command) ;先调用command函数,避免后面计算失败。
- (repeat ssl
- (setq el (entget (ssname ss (setq i (1+ i))))
- str (strcat "1.0*" (cdr (assoc 1 el))) ;调整型为实数,除Bug。
- l (caadr (textbox (list (assoc 1 el) (assoc 40 el))))
- ll (+ l (* 4. (/ l (strlen (cdr (assoc 1 el))))))
- ;nstr (rtos (c:cal str) 2 csd)
- )
- (setq nstr (rtos (c:cal str) 2 csd)) ;把这个单独拿出来了
- (setq el (subst (cons 10 p) (assoc 10 el) el))
- (entmake el) ;写计算式
- (setq el (subst (cons 1 nstr) (assoc 1 el) el)
- p1 (mapcar '+ (list ll 0. 0.) p)
- el (subst (cons 10 p1) (assoc 10 el) el)
- )
- (entmake el);写结果
- (setq p (mapcar '+ p (list 0. (- (* 1.5 (cdr (assoc 40 el)))) 0.))) ;计算下一个插入点
-
- )
- )
- )
- (princ)
- )
|