改一个很小的功能

孙玉坤

求大神帮我修改一个很小的功能，就是在原来的基础上  把两个步骤合并一个，在高版本中CENTERLINE 命名生产的中心线 是不是偏移的图元，只有炸开后才可以偏移，所以增加了这个炸开的步骤    多了很多无用的功    能不能就是有这个中心线  自动的炸开  然后偏移  把两个功能合成一个命令

htlaser

孙玉坤 发表于 2022-3-28 14:52
非常感谢  还有两个小问题  第一就是用CAD2018 提示无法识别的版本 无法读取   第二就会  如果没有中心线 ...

你自已给的什么图就是什么功能   一改再改  再改   自已动手吧

xyp1964

1. (defun c:tt ()
   
2.   (or ww (setq ww 1.00))
   
3.   (setq ww (Udist 7 "" "宽度<输入或鼠标直接量取>" ww nil))
   
4.   (command "CENTERLINE" pause pause)
   
5.   (command "explode" (entlast))
   
6.   (setq        e   (entlast)
   
7.         sp  (vlax-curve-getStartPoint e)
   
8.         ep  (vlax-curve-getendPoint e)
   
9.         ang (angle sp ep)
   
10.         pts (mapcar '(lambda (x)
    
11.                        (list (setq p1 (polar x (+ ang (/ pi 2.0)) (* 0.5 ww)))
    
12.                              (polar p1 (+ ang (* pi 1.5)) ww)
    
13.                        )
    
14.                      )
    
15.                     (list sp ep)
    
16.             )
    
17.         )
    
18.         pts (apply 'append (list (car pts) (reverse (cadr pts))))
    
19.   )
    
20.   (entdel e)
    
21.   (entmakex
    
22.     (append '((0 . "LWPOLYLINE")
    
23.               (100 . "AcDbEntity")
    
24.               (100 . "AcDbPolyline")
    
25.               (90 . 4)
    
26.               (70 . 1)
    
27.              )
    
28.             (mapcar '(lambda (p) (cons 10 p)) pts)
    
29.     )
    
30.   )
    
31.   (princ)
    
32. )
    

(defun c:tt ()<br />   (or ww (setq ww 1.00))<br />   (setq ww (Udist 7 "" "宽度<输入或鼠标直接量取>" ww nil))<br />   (command "CENTERLINE" pause pause)<br />   (command "explode" (entlast))<br />   (setq        e   (entlast)<br />         sp  (vlax-curve-getStartPoint e)<br />         ep  (vlax-curve-getendPoint e)<br />         ang (angle sp ep)<br />         pts (mapcar '(lambda (x)<br />                        (list (setq p1 (polar x (+ ang (/ pi 2.0)) (* 0.5 ww)))<br />                              (polar p1 (+ ang (* pi 1.5)) ww)<br />                        )<br />                      )<br />                     (list sp ep)<br />             )<br />         )<br />         pts (apply 'append (list (car pts) (reverse (cadr pts))))<br />   )<br />   (entdel e)<br />   (entmakex<br />     (append '((0 . "LWPOLYLINE")<br />               (100 . "AcDbEntity")<br />               (100 . "AcDbPolyline")<br />               (90 . 4)<br />               (70 . 1)<br />              )<br />             (mapcar '(lambda (p) (cons 10 p)) pts)<br />     )<br />   )<br />   (princ)<br /> )<br />

htlaser

1. (defun c:test (/ ang cmd e ent ep pts sp width)
   
2.   (setq cmd (getvar "cmdecho"))
   
3.   (setvar "cmdecho" 0)
   
4.   (command "_undo" "be")
   
5.   (or width (setq width 1.00))
   
6.   (setq width (Udist 7 "" "宽度<输入或鼠标直接量取>" width nil))  
   
7.   (command "CENTERLINE" pause pause )
   
8.   (command "explode" (entlast))
   
9.   (setq e  (entlast))
   
10.   (setq ent(entget e)
    
11.     ang (angle  (setq sp (vlax-curve-getStartPoint e))
    
12.           (setq ep (vlax-curve-getendPoint e)))
    
13.   )
    
14.   (setq pts (mapcar '(lambda (pt)
    
15.                        (list (setq p_ (polar pt (+ ang (/ pi 2.0)) (* 0.5 width)))
    
16.                          (polar p_ (+ ang (* pi 1.5)) width)
    
17.                        )
    
18.                      )
    
19.               (list sp ep)
    
20.             )
    
21.     pts (apply 'append (list (car pts) (reverse (cadr pts))))
    
22.   )
    
23.   (entmakex (append (list (cons 0 "LWPOLYLINE")
    
24.                       (cons 100 "AcDbEntity")
    
25.                       (assoc 8 ent)
    
26.                       (cons 100 "AcDbPolyline")
    
27.                       (cons 90 (length pts))
    
28.                       (cons 70 1)
    
29.                     )
    
30.               (mapcar (function (lambda (p) (cons 10 p))) pts)
    
31.             )
    
32.   )
    
33.   (entdel e)  
    
34.   (command "_undo" "e")
    
35.   (setvar "cmdecho" cmd)
    
36.   (princ)
    
37. )
    
38. 
    
39. ;; ------ UDIST -----------
    
40. ;; 距离输入格式化      
    
41. ;; 方式 : (setq dist1 (Udist 1 "" "距离" dist1 '(0 0)))
    
42. (defun Udist (bit kwd msg def bpt / inp)
    
43.   (if def
    
44.     (setq msg (strcat "\n" msg "<" (rtos def) ">: ")
    
45.     bit (* 2 (fix (/ bit 2)))
    
46.     )
    
47.     (setq msg (strcat "\n" msg ": "))
    
48.   )
    
49.   (initget bit kwd)
    
50.   (setq  inp (if  bpt(getdist msg bpt)(getdist msg)))
    
51.   (if inp inp def)
    
52. )
    

(defun c:test (/ ang cmd e ent ep pts sp width)<br />   (setq cmd (getvar "cmdecho"))<br />   (setvar "cmdecho" 0)<br />   (command "_undo" "be")<br />   (or width (setq width 1.00))<br />   (setq width (Udist 7 "" "宽度<输入或鼠标直接量取>" width nil))  <br />   (command "CENTERLINE" pause pause )<br />   (command "explode" (entlast))<br />   (setq e  (entlast))<br />   (setq ent(entget e)<br />     ang (angle  (setq sp (vlax-curve-getStartPoint e))<br />           (setq ep (vlax-curve-getendPoint e)))<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 />   (entdel e)  <br />   (command "_undo" "e")<br />   (setvar "cmdecho" cmd)<br />   (princ)<br /> )<br /> <br /> ;; ------ UDIST -----------<br /> ;; 距离输入格式化       <br /> ;; 方式 : (setq dist1 (Udist 1 "" "距离" dist1 '(0 0)))<br /> (defun Udist (bit kwd msg def bpt / inp)<br />   (if def<br />     (setq msg (strcat "\n" msg "<" (rtos def) ">: ")<br />     bit (* 2 (fix (/ bit 2)))<br />     )<br />     (setq msg (strcat "\n" msg ": "))<br />   )<br />   (initget bit kwd)<br />   (setq  inp (if  bpt(getdist msg bpt)(getdist msg)))<br />   (if inp inp def)<br /> )<br />

孙玉坤

htlaser 发表于 2022-3-27 14:51

有点表达的不太清楚  意思不能直接生产长方形    先把中心线炸开 然后  再偏移    因为我的里面还有直线多段线。 我想把所有的线可以一起偏移  如果可以修改 加个带记忆功能

htlaser

孙玉坤 发表于 2022-3-27 15:26
有点表达的不太清楚  意思不能直接生产长方形    先把中心线炸开 然后  再偏移    因为我的里面还有直线 ...

1. (defun c:test2 (/  ang cmd e ent ep i pts sp ss ssa 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.   (command "CENTERLINE" pause pause )
    
14.       (command "explode" (entlast))  
    
15.       (princ "\n选择对象")  
    
16.       (if (setq ss (ssget '((-4 . "<OR")
    
17.                                 (-4 . "<AND")(0 . "LWPOLYLINE")(90 . 2)(42 . 0)(-4 . "AND>")
    
18.                                 (0 . "LINE")
    
19.                            (-4 . "OR>")
    
20.                            )
    
21.                    )
    
22.           )
    
23.           (repeat (setq i (sslength ss))
    
24.               (setq e (ssname ss (Setq i (1- i))))
    
25.               (setq ent (entget e)
    
26.                     ang (angle        (setq sp (vlax-curve-getStartPoint e))
    
27.                                 (setq ep (vlax-curve-getendPoint e))
    
28.                         )
    
29.               )
    
30.               (setq pts (mapcar '(lambda (pt)
    
31.                                      (list (setq p_ (polar pt (+ ang (/ pi 2.0)) (* 0.5 width)))
    
32.                                            (polar p_ (+ ang (* pi 1.5)) width)
    
33.                                      )
    
34.                                  )
    
35.                                  (list sp ep)
    
36.                         )
    
37.                     pts (apply 'append (list (car pts) (reverse (cadr pts))))
    
38.               )
    
39.               (entmakex (append (list (cons 0 "LWPOLYLINE")
    
40.                                       (cons 100 "AcDbEntity")
    
41.                                       (assoc 8 ent)
    
42.                                       (cons 100 "AcDbPolyline")
    
43.                                       (cons 90 (length pts))
    
44.                                       (cons 70 1)
    
45.                                 )
    
46.                                 (mapcar (function (lambda (p) (cons 10 p))) pts)
    
47.                          )
    
48.               )
    
49.               (setq ssa (ssadd (entlast) ssa))
    
50.               (entdel e)
    
51.           )
    
52.       )
    
53.       (if (> (sslength ssa) 0)
    
54.           (command "_group" "C" "*" "*" ssa "")
    
55.       )
    
56.       (command "_undo" "e")
    
57.       (setvar "cmdecho" cmd)
    
58.       (princ)
    
59. )

(defun c:test2 (/  ang cmd e ent ep i pts sp ss ssa 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 />   (command "CENTERLINE" pause pause )<br />       (command "explode" (entlast))  <br />       (princ "\n选择对象")  <br />       (if (setq ss (ssget '((-4 . "<OR")<br />                                 (-4 . "<AND")(0 . "LWPOLYLINE")(90 . 2)(42 . 0)(-4 . "AND>")<br />                                 (0 . "LINE")<br />                            (-4 . "OR>")<br />                            )<br />                    )<br />           )<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 /> )

孙玉坤

htlaser 发表于 2022-3-27 16:40

上传了一个CAD  有兴趣可以看一下  

xj6019

直接看不懂问题描述

孙玉坤

xj6019 发表于 2022-3-27 19:11
直接看不懂问题描述

看一下 CAD图会好些,意思  不是直接生成中心线边矩形，而是  在我画好的 多段线和中心线的  的基础上  线段边矩形，但中心线不能编辑 ，需要炸开，所以我的意思是 如果有中心线   先执行炸开命令  然后再和其他多段线   变成矩形

xyp1964