改一个很小的功能

htlaser

孙玉坤 发表于 2022-3-27 16:55
上传了一个CAD  有兴趣可以看一下

算了  还是动手找点码组一个吧.

1. (defun c:test4 (/ ang cmd e ent ep i pts sp ss ssa ssin ssle sss width)
   
2.       (setq cmd (getvar "cmdecho"))
   
3.       (setvar "cmdecho" 0)
   
4.       (command "_undo" "be")
   
5.       (setq ssa (ssadd))
   
6.   (if (null *width)
   
7.     (setq *width 1.00)
   
8.   )
   
9.   (if (setq width(getdist (strcat "\n输入宽度 <" (rtos *width) ">:")))
   
10.     (setq *width width)
    
11.     (setq width *width)
    
12.   )  
    
13. (setq sss (ssget))
    
14.   (progn
    
15.     (setq ssin (ssget "p" (list (cons  0  "INSERT")( cons 6  "CENTER2"))))
    
16.     (command "select" sss "")
    
17.     (setq ssle (ssget "p" '((-4 . "<OR") (-4 . "<AND")(0 . "LWPOLYLINE")(90 . 2)(42 . 0)(-4 . "AND>") (0 . "LINE")(-4 . "OR>"))))  
    
18.     (setq ss (ss_sum  (trtr  ssin) ssle)))
    
19.           (repeat (setq i (sslength ss))
    
20.               (setq e (ssname ss (Setq i (1- i))))
    
21.               (setq ent (entget e)
    
22.                     ang (angle        (setq sp (vlax-curve-getStartPoint e))
    
23.                                 (setq ep (vlax-curve-getendPoint e))
    
24.                         )
    
25.               )
    
26.               (setq pts (mapcar '(lambda (pt)
    
27.                                      (list (setq p_ (polar pt (+ ang (/ pi 2.0)) (* 0.5 width)))
    
28.                                            (polar p_ (+ ang (* pi 1.5)) width)
    
29.                                      )
    
30.                                  )
    
31.                                  (list sp ep)
    
32.                         )
    
33.                     pts (apply 'append (list (car pts) (reverse (cadr pts))))
    
34.               )
    
35.               (entmakex (append (list (cons 0 "LWPOLYLINE")
    
36.                                       (cons 100 "AcDbEntity")
    
37.                                       (assoc 8 ent)
    
38.                                       (cons 100 "AcDbPolyline")
    
39.                                       (cons 90 (length pts))
    
40.                                       (cons 70 1)
    
41.                                 )
    
42.                                 (mapcar (function (lambda (p) (cons 10 p))) pts)
    
43.                          )
    
44.               )
    
45.               (setq ssa (ssadd (entlast) ssa))
    
46.               (entdel e)
    
47.           )
    
48.      
    
49.       (if (> (sslength ssa) 0)
    
50.           (command "_group" "C" "*" "*" ssa "")
    
51.       )
    
52.       (command "_undo" "e")
    
53.       (setvar "cmdecho" cmd)
    
54.       (princ)
    
55. )
    
56. 
    
57. 
    
58. 
    
59. 
    
60. 
    
61. 
    
62. 
    
63. (defun ss_sum (ss1 ss2)  
    
64. (setq i 0)
    
65. (repeat (sslength ss1)
    
66.   (ssadd (ssname ss1 i) ss2)
    
67.   (setq i (1+ i))
    
68. )
    
69. ss2
    
70. )
    
71. 
    
72. (defun trtr (ss / ent n ss1)
    
73.   (progn
    
74.     (setq n -1 ss1 (ssadd))
    
75.     (repeat (sslength ss)
    
76.       (setq ent (ssname ss (setq n (1+ n))))
    
77.       (command "QAFLAGS" 1 "_.EXPLODE" ent "" "QAFLAGS" 0)
    
78.       (ssadd (entlast) ss1)
    
79.     )
    
80.   )
    
81. (if (zerop (sslength ss1))  nil  ss1)
    
82. )

(defun c:test4 (/ ang cmd e ent ep i pts sp ss ssa ssin ssle sss width)<br />       (setq cmd (getvar "cmdecho"))<br />       (setvar "cmdecho" 0)<br />       (command "_undo" "be")<br />       (setq ssa (ssadd))<br />   (if (null *width)<br />     (setq *width 1.00)<br />   )<br />   (if (setq width(getdist (strcat "\n输入宽度 <" (rtos *width) ">:")))<br />     (setq *width width)<br />     (setq width *width)<br />   )  <br /> (setq sss (ssget)) <br />   (progn<br />     (setq ssin (ssget "p" (list (cons  0  "INSERT")( cons 6  "CENTER2"))))<br />     (command "select" sss "")<br />     (setq ssle (ssget "p" '((-4 . "<OR") (-4 . "<AND")(0 . "LWPOLYLINE")(90 . 2)(42 . 0)(-4 . "AND>") (0 . "LINE")(-4 . "OR>"))))  <br />     (setq ss (ss_sum  (trtr  ssin) ssle)))<br />           (repeat (setq i (sslength ss))<br />               (setq e (ssname ss (Setq i (1- i))))<br />               (setq ent (entget e)<br />                     ang (angle        (setq sp (vlax-curve-getStartPoint e))<br />                                 (setq ep (vlax-curve-getendPoint e))<br />                         )<br />               )<br />               (setq pts (mapcar '(lambda (pt)<br />                                      (list (setq p_ (polar pt (+ ang (/ pi 2.0)) (* 0.5 width)))<br />                                            (polar p_ (+ ang (* pi 1.5)) width)<br />                                      )<br />                                  )<br />                                  (list sp ep)<br />                         )<br />                     pts (apply 'append (list (car pts) (reverse (cadr pts))))<br />               )<br />               (entmakex (append (list (cons 0 "LWPOLYLINE")<br />                                       (cons 100 "AcDbEntity")<br />                                       (assoc 8 ent)<br />                                       (cons 100 "AcDbPolyline")<br />                                       (cons 90 (length pts))<br />                                       (cons 70 1)<br />                                 )<br />                                 (mapcar (function (lambda (p) (cons 10 p))) pts)<br />                          )<br />               )<br />               (setq ssa (ssadd (entlast) ssa))<br />               (entdel e)<br />           )<br />      <br />       (if (> (sslength ssa) 0)<br />           (command "_group" "C" "*" "*" ssa "")<br />       )<br />       (command "_undo" "e")<br />       (setvar "cmdecho" cmd)<br />       (princ)<br /> )<br /> <br /> <br /> <br /> <br /> <br /> <br /> <br /> (defun ss_sum (ss1 ss2)  <br /> (setq i 0)<br /> (repeat (sslength ss1)<br />   (ssadd (ssname ss1 i) ss2)<br />   (setq i (1+ i))<br /> )<br /> ss2<br /> )<br /> <br /> (defun trtr (ss / ent n ss1)<br />   (progn<br />     (setq n -1 ss1 (ssadd))<br />     (repeat (sslength ss)<br />       (setq ent (ssname ss (setq n (1+ n))))<br />       (command "QAFLAGS" 1 "_.EXPLODE" ent "" "QAFLAGS" 0)<br />       (ssadd (entlast) ss1)<br />     )<br />   )<br /> (if (zerop (sslength ss1))  nil  ss1)<br /> )

孙玉坤

htlaser 发表于 2022-3-28 13:52
算了  还是动手找点码组一个吧.

非常感谢  还有两个小问题  第一就是用CAD2018 提示无法识别的版本 无法读取   第二就会  如果没有中心线    全部是多段线是就不执行。或者都是中线线时也不能执行

孙玉坤

htlaser 发表于 2022-3-28 14:55
你自已给的什么图就是什么功能   一改再改  再改   自已动手吧

好的就是不会  刚接触  

htlaser

孙玉坤 发表于 2022-3-28 14:56
好的就是不会  刚接触

金牌会员   加个判断应该不难吧!  判断是不是有中心线

htlaser

孙玉坤 发表于 2022-3-28 14:56
好的就是不会  刚接触

等我有空再修改吧

孙玉坤

htlaser 发表于 2022-3-28 14:59
等我有空再修改吧

我是在线多  今天刚学lisp
假的会员

htlaser

孙玉坤 发表于 2022-3-28 15:01
我是在线多  今天刚学lisp
假的会员

1. (defun c:test4 (/ ang cmd e ent ep i pts sp ss ssa ssin ssle sss width)
   
2.   (setq cmd (getvar "cmdecho"))
   
3.   (setvar "cmdecho" 0)
   
4.   (command "_undo" "be")
   
5.   (setq ssa (ssadd))
   
6.   (if (null *width)
   
7.     (setq *width 1.00)
   
8.   )
   
9.   (if (setq width(getdist (strcat "\n输入宽度 <" (rtos *width) ">:")))
   
10.     (setq *width width)
    
11.     (setq width *width)
    
12.   )  
    
13.   (setq sss (ssget))
    
14.   (progn
    
15.     (setq ssin (ssget "p" (list (cons  0  "INSERT")( cons 6  "CENTER2"))))
    
16.     (command "select" sss "")
    
17.     (setq ssle (ssget "p" '((-4 . "<OR") (-4 . "<AND")(0 . "LWPOLYLINE")(90 . 2)(42 . 0)(-4 . "AND>") (0 . "LINE")(-4 . "OR>"))))
    
18.     (if (= nil ssin) (setq ss ssle)  ;判断INSERT
    
19.       (if (= nil ssle) (setq ss (trtr  ssin)) ;判断LINE
    
20.         (setq ss (ss_sum   ssle  (trtr  ssin))))))
    
21.   (repeat (setq i (sslength ss))
    
22.     (setq e (ssname ss (Setq i (1- i))))
    
23.     (setq ent (entget e)
    
24.       ang (angle        (setq sp (vlax-curve-getStartPoint e))
    
25.             (setq ep (vlax-curve-getendPoint e))
    
26.           )
    
27.     )
    
28.     (setq pts (mapcar '(lambda (pt)
    
29.                          (list (setq p_ (polar pt (+ ang (/ pi 2.0)) (* 0.5 width)))
    
30.                            (polar p_ (+ ang (* pi 1.5)) width)
    
31.                          )
    
32.                        )
    
33.                 (list sp ep)
    
34.               )
    
35.       pts (apply 'append (list (car pts) (reverse (cadr pts))))
    
36.     )
    
37.     (entmakex (append (list (cons 0 "LWPOLYLINE")
    
38.                         (cons 100 "AcDbEntity")
    
39.                         (assoc 8 ent)
    
40.                         (cons 100 "AcDbPolyline")
    
41.                         (cons 90 (length pts))
    
42.                         (cons 70 1)
    
43.                       )
    
44.                 (mapcar (function (lambda (p) (cons 10 p))) pts)
    
45.               )
    
46.     )
    
47.     (setq ssa (ssadd (entlast) ssa))
    
48.     (entdel e)
    
49.   )
    
50.   
    
51.   (if (> (sslength ssa) 0)
    
52.     (command "_group" "C" "*" "*" ssa "")
    
53.   )
    
54.   (command "_undo" "e")
    
55.   (setvar "cmdecho" cmd)
    
56.   (princ)
    
57. )
    
58. 
    
59. (defun ss_sum (ss1 ss2)  
    
60.   (setq i 0)
    
61.   (repeat (sslength ss1)
    
62.     (ssadd (ssname ss1 i) ss2)
    
63.     (setq i (1+ i))
    
64.   )
    
65.   ss2
    
66. )
    
67. 
    
68. (defun trtr (ss / ent n ss1)
    
69.   (progn
    
70.     (setq n -1 ss1 (ssadd))
    
71.     (repeat (sslength ss)
    
72.       (setq ent (ssname ss (setq n (1+ n))))
    
73.       (command "QAFLAGS" 1 "_.EXPLODE" ent "" "QAFLAGS" 0)
    
74.       (ssadd (entlast) ss1)
    
75.     )
    
76.   )
    
77.   (if (zerop (sslength ss1))  nil  ss1)
    
78. )

(defun c:test4 (/ ang cmd e ent ep i pts sp ss ssa ssin ssle sss width)<br />   (setq cmd (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (command "_undo" "be")<br />   (setq ssa (ssadd))<br />   (if (null *width)<br />     (setq *width 1.00)<br />   )<br />   (if (setq width(getdist (strcat "\n输入宽度 <" (rtos *width) ">:")))<br />     (setq *width width)<br />     (setq width *width)<br />   )  <br />   (setq sss (ssget)) <br />   (progn<br />     (setq ssin (ssget "p" (list (cons  0  "INSERT")( cons 6  "CENTER2"))))<br />     (command "select" sss "")<br />     (setq ssle (ssget "p" '((-4 . "<OR") (-4 . "<AND")(0 . "LWPOLYLINE")(90 . 2)(42 . 0)(-4 . "AND>") (0 . "LINE")(-4 . "OR>")))) <br />     (if (= nil ssin) (setq ss ssle)  ;判断INSERT<br />       (if (= nil ssle) (setq ss (trtr  ssin)) ;判断LINE<br />         (setq ss (ss_sum   ssle  (trtr  ssin))))))<br />   (repeat (setq i (sslength ss))<br />     (setq e (ssname ss (Setq i (1- i))))<br />     (setq ent (entget e)<br />       ang (angle        (setq sp (vlax-curve-getStartPoint e))<br />             (setq ep (vlax-curve-getendPoint e))<br />           )<br />     )<br />     (setq pts (mapcar '(lambda (pt)<br />                          (list (setq p_ (polar pt (+ ang (/ pi 2.0)) (* 0.5 width)))<br />                            (polar p_ (+ ang (* pi 1.5)) width)<br />                          )<br />                        )<br />                 (list sp ep)<br />               )<br />       pts (apply 'append (list (car pts) (reverse (cadr pts))))<br />     )<br />     (entmakex (append (list (cons 0 "LWPOLYLINE")<br />                         (cons 100 "AcDbEntity")<br />                         (assoc 8 ent)<br />                         (cons 100 "AcDbPolyline")<br />                         (cons 90 (length pts))<br />                         (cons 70 1)<br />                       )<br />                 (mapcar (function (lambda (p) (cons 10 p))) pts)<br />               )<br />     )<br />     (setq ssa (ssadd (entlast) ssa))<br />     (entdel e)<br />   )<br />   <br />   (if (> (sslength ssa) 0)<br />     (command "_group" "C" "*" "*" ssa "")<br />   )<br />   (command "_undo" "e")<br />   (setvar "cmdecho" cmd)<br />   (princ)<br /> )<br /> <br /> (defun ss_sum (ss1 ss2)  <br />   (setq i 0)<br />   (repeat (sslength ss1)<br />     (ssadd (ssname ss1 i) ss2)<br />     (setq i (1+ i))<br />   )<br />   ss2<br /> )<br /> <br /> (defun trtr (ss / ent n ss1)<br />   (progn<br />     (setq n -1 ss1 (ssadd))<br />     (repeat (sslength ss)<br />       (setq ent (ssname ss (setq n (1+ n))))<br />       (command "QAFLAGS" 1 "_.EXPLODE" ent "" "QAFLAGS" 0)<br />       (ssadd (entlast) ss1)<br />     )<br />   )<br />   (if (zerop (sslength ss1))  nil  ss1)<br /> )

孙玉坤

htlaser 发表于 2022-3-28 15:30

非常完美 万分感谢

xyp1964

htlaser 发表于 2022-3-28 15:30

(setq ssin (ssget "p" (list (cons  0  "INSERT")( cons 6  "CENTER2"))))

不一定是centerline命令生成的中心线实体

htlaser

xyp1964 发表于 2022-3-28 17:41
(setq ssin (ssget "p" (list (cons  0  "INSERT")( cons 6  "CENTER2"))))

不一定是centerline命令生 ...

感谢院长关注,
我也不敢确定,只是按图来判断 .
如果不是用(setq ssin (ssget "p" (list (cons  0  "INSERT"))))  这样更不安全.