图层调整求助

shcvip

1. 
   

复制代码

2. (defun HTddgd (/ arcss dw_index  dw_list  ename index linetype pipess
   
3.          r_list)
   
4. 
   
5.   (princ "\n 选择多段中心线:")
   
6.   (vl-load-com)
   
7.   (setvar "cmdecho" 0)
   
8. ;;;
   
9.   (defun *error* (msg)
   
10.     (if  (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")
    
11.       (princ "\n用户按了<Esc>强制退出")
    
12.       (princ (strcat "\n" msg))
    
13.     )
    
14.     (vla-EndUndoMark
    
15.       (vla-get-ActiveDocument (vlax-get-acad-object))
    
16.     )          ;回退
    
17.     (princ)
    
18.   )
    
19.   (setq *DOC (vla-get-ActiveDocument (vlax-get-acad-object)))
    
20.   (vla-StartUndoMark *DOC)    ;设置回退标志
    
21. 
    
22.   (setq  c03 (getvar "viewctr")
    
23.   c03 (trans c03 1 2)
    
24.   c08 (getvar "viewsize")
    
25.   c04 (getvar "screensize")
    
26.   c07 (car c04)
    
27.   c06 (cadr c04)
    
28.   c09 (/ (* c08 c07) c06)
    
29.   c01 (list (- (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08)))
    
30.   c02 (list (+ (car c03) (* 0.5 c09)) (+ (cadr c03) (* 0.5 c08)))
    
31.   c01 (trans c01 2 1)
    
32.   c02 (trans c02 2 1)
    
33.   )
    
34.   (if (setq pipess (ssget (list (cons 0 "line"))))
    
35.     (command "change" pipess "" "p" "la" "z_中心线" "")
    
36.   )
    
37. 
    
38.   (setq arcss (pipesfillet pipess GD_qlR))
    
39.   (setq index 0)
    
40.   (repeat (sslength pipess)
    
41.     (setq ename     (ssname pipess index)
    
42.     index     (1+ index)
    
43.     linetype (cdr (assoc 0 (entget ename)))
    
44.     )
    
45.     (if  (= linetype "LINE")
    
46.       (linesx ename GD_D)
    
47.       (arcsx ename GD_D)
    
48.     )
    
49.   )
    
50.   (setq index 0)
    
51.   (repeat (sslength arcss)
    
52.     (setq ename     (ssname arcss index)
    
53.     index     (1+ index)
    
54.     linetype (cdr (assoc 0 (entget ename)))
    
55.     )
    
56.     (arcsx ename GD_D)
    
57.     (setq entdata (entget ename))
    
58.     (if  (assoc 6 entdata)
    
59. ;;;      (setq entdata (subst (cons 6 "CENTER") (assoc 6 entdata) entdata))
    
60.       (setq
    
61.   entdata  (subst (cons 8 "L_轮廓线") (assoc 6 entdata) entdata)
    
62.       ) ;;此数据不知道控制哪条直线
    
63. ;;;      (setq entdata (append entdata '((6 . "CENTER"))))
    
64.       (setq entdata (append entdata '((8 . "Z_中心线")))) ;;圆弧内的中心线
    
65.     )
    
66. 
    
67. 
    
68.     (entmod entdata)
    
69.   )
    
70.   (setvar "cmdecho" 0)
    
71.   (command "zoom" c01 c02)
    
72.   ;;结尾部分
    
73. ;;;  (Restore_Locked_Layers Locks)    ;恢复以前图层状态
    
74.   (vla-EndUndoMark *DOC)    ;回退标志结束
    
75.   (princ)
    
76. )

(defun HTddgd (/ arcss dw_index  dw_list  ename index linetype pipess<br />          r_list)<br /> <br />   (princ "\n 选择多段中心线:")<br />   (vl-load-com)<br />   (setvar "cmdecho" 0)<br /> ;;;<br />   (defun *error* (msg)<br />     (if  (wcmatch (strcase msg t) "*break,*cancel*,*exit*,*取消*")<br />       (princ "\n用户按了<Esc>强制退出")<br />       (princ (strcat "\n" msg))<br />     )<br />     (vla-EndUndoMark<br />       (vla-get-ActiveDocument (vlax-get-acad-object))<br />     )          ;回退<br />     (princ)<br />   )<br />   (setq *DOC (vla-get-ActiveDocument (vlax-get-acad-object)))<br />   (vla-StartUndoMark *DOC)    ;设置回退标志<br /> <br />   (setq  c03 (getvar "viewctr")<br />   c03 (trans c03 1 2)<br />   c08 (getvar "viewsize")<br />   c04 (getvar "screensize")<br />   c07 (car c04)<br />   c06 (cadr c04)<br />   c09 (/ (* c08 c07) c06)<br />   c01 (list (- (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08)))<br />   c02 (list (+ (car c03) (* 0.5 c09)) (+ (cadr c03) (* 0.5 c08)))<br />   c01 (trans c01 2 1)<br />   c02 (trans c02 2 1)<br />   )<br />   (if (setq pipess (ssget (list (cons 0 "line"))))<br />     (command "change" pipess "" "p" "la" "z_中心线" "")<br />   )<br /> <br />   (setq arcss (pipesfillet pipess GD_qlR))<br />   (setq index 0)<br />   (repeat (sslength pipess)<br />     (setq ename     (ssname pipess index)<br />     index     (1+ index)<br />     linetype (cdr (assoc 0 (entget ename)))<br />     )<br />     (if  (= linetype "LINE")<br />       (linesx ename GD_D)<br />       (arcsx ename GD_D)<br />     )<br />   )<br />   (setq index 0)<br />   (repeat (sslength arcss)<br />     (setq ename     (ssname arcss index)<br />     index     (1+ index)<br />     linetype (cdr (assoc 0 (entget ename)))<br />     )<br />     (arcsx ename GD_D)<br />     (setq entdata (entget ename))<br />     (if  (assoc 6 entdata)<br /> ;;;      (setq entdata (subst (cons 6 "CENTER") (assoc 6 entdata) entdata))<br />       (setq<br />   entdata  (subst (cons 8 "L_轮廓线") (assoc 6 entdata) entdata)<br />       ) ;;此数据不知道控制哪条直线<br /> ;;;      (setq entdata (append entdata '((6 . "CENTER"))))<br />       (setq entdata (append entdata '((8 . "Z_中心线")))) ;;圆弧内的中心线<br />     )<br /> <br /> <br />     (entmod entdata)<br />   )<br />   (setvar "cmdecho" 0)<br />   (command "zoom" c01 c02)<br />   ;;结尾部分<br /> ;;;  (Restore_Locked_Layers Locks)    ;恢复以前图层状态<br />   (vla-EndUndoMark *DOC)    ;回退标志结束<br />   (princ)<br /> )

飞雪神光

可以通过组码62 或者 vla-put-Color 设置颜色 你给这代码别人不能直接测试先不说 画出来的东西也跟图片没关系啊

czb203

大佬，会用ai写代码，厉害啊~

shcvip

飞雪神光 发表于 2024-8-21 01:03
可以通过组码62 或者 vla-put-Color 设置颜色 你给这代码别人不能直接测试先不说 画出来的东西也跟图片没关 ...

应该是图层，中间的是中心线层，外面的的轮廓层，然后弯头目前也变成了中心层，想改为轮廓层。

飞雪神光

shcvip 发表于 2024-8-21 14:17
应该是图层，中间的是中心线层，外面的的轮廓层，然后弯头目前也变成了中心层，想改为轮廓层。

图层是组码8

咏郡

你这是要干什么，画吗?

shcvip

飞雪神光 发表于 2024-8-21 14:23
图层是组码8

里面备注了，可否帮我再看看。

飞雪神光

shcvip 发表于 2024-8-21 23:31
里面备注了，可否帮我再看看。

帮不了 代码毫无逻辑  看不懂写得是啥 且缺少函数与变量 你这是AI写的吧