树櫴希德 发表于 2019-6-3 21:29:37

圆圈编号 大神们在好好完善下吧

;;;;;;;;;;;;;;;;;
(defun insertgc ( e / e)
(cdr(assoc 10(entget e)))
)
;;;;





(defun cx-ss2en
(ss / enlst)
(cond
    ((= (type ss) 'PICKSET)
      (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
    )
    ((= (type ss) 'LIST)
      (setq enlst (ssadd))
      (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
    )
    ((='ename(type ss))
      (ssadd ss)
    )
)
)
;;;;;;;;;;;;;;;;;;
(defun t2t (p1 p2 p3 / p1 p2 p3) ;点到直线距离1


(abs (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1))))

)   ;;;;;;;;;;;;;;;;

(defun t1t (p1 p2 p3 / p1 p2 p3) ;点到直线距离2


   (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1)))

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:szpx (/ ssa kongbiao i ii zb paixuzb p1 p2 fgjj p3 cishu kb kbb iii iiii wenzi)
(setq ssa (ssget '( (0 . "circle")(8 . "0") ) ) )
(setq kongbiao '()) (setq i 0)
(foreach x (cx-ss2en ssa)
   
    (setq zb (insertgc x)) (setq kongbiao (append (list zb) kongbiao)) (setq i (1+ i))
)

(setq paixuzb (vl-sort kongbiao
             (function (lambda (e1 e2)      (> (cadr e1)(cadr e2 ) )   
            ) ) )
       )
(setq p1 (getpoint "\n请选择直线起点："))
(setq p2 (getpoint "\n请选择直线第二点："))
(setq fgjj (getREAL "\n请输入方格间距(输入数)："));输入整数
(setq p3 (last paixuzb))
(setq cishu (+ 2 (fix (/ (t2t p1 p2 p3) fgjj )) ) )
(setq kb '()) (setq ii 0)
(repeat cishu
   

(setq kbb
(vl-sort (vl-remove-if-not(FUNCTION (LAMBDA (A1) (< (* -1 fgjj) (t1t (polar p1 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) (polar p2 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) A1) 0) ))kongbiao)
             (function (lambda (e1 e2)      (> (car e1)(car e2 ) )   (< (cadr e1)(cadr e2 ) )
            ) ) )

)(print kbb)
(setq iiii 0)
(FOREACH x kbb
(setq iiii (1+ iiii))

(setq wenzi (strcat (vl-prin1-to-stringii) "-" (vl-prin1-to-stringiiii)))

(entmake (list '(0 . "TEXT") '(8 . "fgbaj")(cons 1 wenzi) (cons 10 x ) (cons 40 0.250)))
)

(setq kb (append kbb kb))

(setq ii (1+ ii))


)
(setq iii 0)
(foreach n (reverse kb)


   ;(entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos (+ iii 1) 2 0)) (cons 10 n ) (cons 40 0.250)))
;(entmake (list '(0 . "circle") '(8 . "fgbj")(cons 62 3) (cons 10 n ) (cons 40 0.25)))
(setq iii (1+ iii))

)

(princ)
)

树櫴希德 发表于 2019-6-3 21:50:27

另外一种不同效果的;;;;;;;;;;;;;;;;;
(defun insertgc ( e / e)
(cdr(assoc 10(entget e)))
)
;;;;





(defun cx-ss2en
(ss / enlst)
(cond
    ((= (type ss) 'PICKSET)
      (vl-remove-if-not '(lambda (x) (= (type x) 'ENAME)) (mapcar 'cadr (ssnamex SS)))
    )
    ((= (type ss) 'LIST)
      (setq enlst (ssadd))
      (last (mapcar '(lambda (x) (ssadd x enlst)) ss))
    )
    ((='ename(type ss))
      (ssadd ss)
    )
)
)
;;;;;;;;;;;;;;;;;;
(defun t2t (p1 p2 p3 / p1 p2 p3) ;点到直线距离1


(abs (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1))))

)   ;;;;;;;;;;;;;;;;

(defun t1t (p1 p2 p3 / p1 p2 p3) ;点到直线距离2


   (car (trans (mapcar '- p3 p1) 0 (mapcar '- p2 p1)))

)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun c:szpx (/ ssa kongbiao i ii zb paixuzb p1 p2 fgjj p3 cishu kb kbb iii iiii wenzi x n )
(setq ssa (ssget '( (0 . "circle")(8 . "0") ) ) )
(setq kongbiao '()) (setq i 0)
(foreach x (cx-ss2en ssa)
   
    (setq zb (insertgc x)) (setq kongbiao (append (list zb) kongbiao)) (setq i (1+ i))
)

(setq paixuzb (vl-sort kongbiao
             (function (lambda (e1 e2)      (> (cadr e1)(cadr e2 ) )   
            ) ) )
       )
(setq p1 (getpoint "\n请选择直线起点："))
(setq p2 (getpoint "\n请选择直线第二点："))
(setq fgjj (getREAL "\n请输入方格间距(输入数)："));输入整数
(setq p3 (last paixuzb))
(setq cishu (+ 2 (fix (/ (t2t p1 p2 p3) fgjj )) ) )
(setq kb '() ) (setq ii 0)
(repeat cishu
   

(setq kbb
(vl-sort (vl-remove-if-not(FUNCTION (LAMBDA (A1) (< (* -1 fgjj) (t1t (polar p1 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) (polar p2 (+ (* 0.5 pi)(angle p1 p2)) (* ii fgjj)) A1) 0) ))kongbiao)
             (function (lambda (e1 e2)      (> (car e1)(car e2 ) )   (< (cadr e1)(cadr e2 ) )
            ) ) )

) ; (print kbb)


(setq kb (append (list kbb) kb))

(setq ii (1+ ii))


)(print (car kb))
(setq iii 0)
(foreach n kb

(setq iiii 0)
(FOREACH x n
(setq iiii (1+ iiii))

(setq wenzi (strcat (vl-prin1-to-stringiii) "-" (vl-prin1-to-stringiiii)))

(entmake (list '(0 . "TEXT") '(8 . "fgbaj")(cons 1 wenzi) (cons 10 x ) (cons 40 0.250)))
)


   ;(entmake (list '(0 . "TEXT") '(8 . "fgbj")(cons 1 (rtos (+ iii 1) 2 0)) (cons 10 n ) (cons 40 0.250)))
;(entmake (list '(0 . "circle") '(8 . "fgbj")(cons 62 3) (cons 10 n ) (cons 40 0.25)))
(setq iii (1+ iii))

)

(princ)
)

树櫴希德 发表于 2019-6-3 22:01:32


附件上传

13648893846 发表于 2019-6-4 05:35:37

文字长度能否跟圆的半径扯上点关系，对正方式也改下

13648893846 发表于 2019-6-4 05:38:28

实际上不用画出那条线来第一排的两端的圆即可判断了
页: [1]
查看完整版本: 圆圈编号 大神们在好好完善下吧