在直线交点自动画带圆圈序号，需要修剪圈内线段的问题

yxh1202

因工作原因，需要在很多交点上画带圆圈的序号，找到一个程序可以实现，但是需要进一步增加标注序号后，能自动剪切圈内的线段，样例如下：



(defun c:nd ()
   (setvar "CMDECHO" 0)
   ;;;(setq sc (getdist "\nselect a point to point 从一点到另一点确定字体高度 :"))
(setq sc (getint "\nselect a point to point 输入字体高度 :"))
   (setq bn (getint "\nInput begin number 输入起始序号："))
   (setq sc1 (* sc 0.53))
   (while (setq p1 (getpoint "\nInsert Point :"))
    (command "circle" p1 "d" sc)
    (command "text" "j" "m" p1 sc1 "" bn)
    (setq s1 (entlast))
    (setq txtn (itoa bn))
    (setq bn (1+ bn))
    (while (and (setq ss (ssget "X" (list '(0 . "TEXT") (cons 1 txtn))))
           (= (sslength ss) 2))
     (setq ss (ssdel s1 ss)
           s1 (ssname ss 0)
           ent (entget s1)
           txtn (itoa (1+ (atoi txtn)))
           ent (subst (cons 1 txtn) (assoc 1 ent) ent))
     (entmod ent)
    )
   )
   (setvar "CMDECHO" 1)
   (princ)
)



请群里高人给修改完善下

yoyoho

;; ctrim.lsp  v1.1
;; Modified By Xiaxiang

(defun c:ctrim ( / circ_pts lst ang inc tmp seg pt ent ss1 num
                   ctrim_err x f_pts svd_os svd_cmd svd_err)

(defun ctrim_err (s)
  (if(/= s "Function cancelled")
  (princ(strcat "\n\n" s))     )
  (setvar "cmdecho" svd_cmd)
  (setvar "osmode" svd_os)
  (setq *error* svd_err)
)

(defun circ_pts (enm)
  (setq lst    (entget enm)
        ang    (* pi 2)
        inc    (/ ang 64)
        tmp    '()
        seg    65
  )
  (repeat seg
   (setq pt (polar(cdr(assoc 10 lst))ang
            (-(cdr(assoc 40 lst))0.01))
        ang (+ inc ang)
   )
   (setq tmp(cons pt tmp))
  )
  tmp
)

;;add ssget function
(setq num 0)
(prompt "\nSelect circles: ")
(setq ss1 (ssget '((0 . "CIRCLE"))))
(setq ;ent     (car(entsel "\nSelect circle: ")) ;;entsel
       svd_err *error*
       *error* ctrim_err
       svd_os  (getvar "osmode")
       svd_cmd (getvar "cmdecho")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(repeat (sslength ss1)
(setq ent(ssname ss1 num))
(setq num(1+ num))
(if(and ent
     (=(cdr(assoc 0(entget ent)))"CIRCLE")
    )
  (progn
   (setq f_pts(circ_pts ent))
   (command "trim" ent "" "f")   ;run twice in case the same
   (foreach x f_pts(command x))  ;object intersects circle twice
   (command "" "")
   (command "trim" ent "" "f")
   (foreach x f_pts(command x))
   (command "" "")
   (if(setq x(ssget "wp" f_pts '((0 . "~TEXT"))))
    (command "erase" x "")
   )
  )
)
)
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
(princ)
)

yxh1202

找到论坛里面可以批量修剪圆内线段，但是执行后，把圈内的文字也删除了，看了半天，这个代码好像老外写的，请高人修改，实现批量修剪圈内线段，同时保留文字，谢谢
;; ctrim.lsp  v1.1
;; Modified By Xiaxiang

(defun c:ctrim ( / circ_pts lst ang inc tmp seg pt ent ss1 num
                   ctrim_err x f_pts svd_os svd_cmd svd_err)

(defun ctrim_err (s)
  (if(/= s "Function cancelled")
  (princ(strcat "\n\n" s))     )
  (setvar "cmdecho" svd_cmd)
  (setvar "osmode" svd_os)
  (setq *error* svd_err)
)

(defun circ_pts (enm)
  (setq lst    (entget enm)
        ang    (* pi 2)
        inc    (/ ang 64)
        tmp    '()
        seg    65
  )
  (repeat seg
   (setq pt (polar(cdr(assoc 10 lst))ang
            (-(cdr(assoc 40 lst))0.01))
        ang (+ inc ang)
   )
   (setq tmp(cons pt tmp))
  )
  tmp
)

;;add ssget function
(setq num 0)
(prompt "\nSelect circles: ")
(setq ss1 (ssget '((0 . "CIRCLE"))))
(setq ;ent     (car(entsel "\nSelect circle: ")) ;;entsel
       svd_err *error*
       *error* ctrim_err
       svd_os  (getvar "osmode")
       svd_cmd (getvar "cmdecho")
)
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(repeat (sslength ss1)
(setq ent(ssname ss1 num))
(setq num(1+ num))
(if(and ent
     (=(cdr(assoc 0(entget ent)))"CIRCLE")
    )
  (progn
   (setq f_pts(circ_pts ent))
   (command "trim" ent "" "f")   ;run twice in case the same
   (foreach x f_pts(command x))  ;object intersects circle twice
   (command "" "")
   (command "trim" ent "" "f")
   (foreach x f_pts(command x))
   (command "" "")
   (if(setq x(ssget "wp" f_pts))
    (command "erase" x "")
   )
  )
)
)
(setvar "cmdecho" svd_cmd)
(setvar "osmode" svd_os)
(setq *error* svd_err)
(princ)
)

panliang9

你把文字统一放进一个层，然后冻结不就可以了吗。这样剪圆内对象的时候不就无法剪了。

至于你第一步，这个程序需要一个点一个点的选是不是效率低了一些。

yxh1202

yoyoho 发表于 2019-5-2 17:35
;; ctrim.lsp  v1.1
;; Modified By Xiaxiang

厉害，学习了。节日快乐

AndyWang

楼主，两个程序如果拼接呀。我电气这边也需要用到类似功能。我试着拼过，水平不够

zhangrunze

yoyoho 发表于 2019-5-2 17:35
;; ctrim.lsp  v1.1
;; Modified By Xiaxiang

厉害了~
已经实现了批量修剪圈内线段并保留圆圈内的文字。
代码完美运行~

aggdqty

zhangrunze 发表于 2024-4-1 08:53
厉害了~
已经实现了批量修剪圈内线段并保留圆圈内的文字。
代码完美运行~

你好，可以分享一下吗

zhangrunze

aggdqty 发表于 2024-4-10 15:21
你好，可以分享一下吗

我就是用的这个帖子的代码呀~ctrim.lsp  v1.1
你都试试就清楚了。我这边是没有问题呢~

aggdqty

请问这个功能实现了吗