求助：怎样点取直线然后自动在两侧生成偏移10的直线？

monsterking

各位好，小弟在制图中，用最多的命令是offset，遇到如题所说有情况时，正常情况下要做10个动作才能完成，请问怎样用autolisp编写一个程序，更快地完成这个工作，衷心谢谢各位。

叮咚

1. (vl-load-com)
   
2. (defun c:of2(/ old_os ss m n en obj)
   
3. (setq old_os (getvar "osmode"))
   
4. (setvar "osmode" 0)
   
5. (setvar "cmdecho" 0)
   
6. (princ "\nSelect a line(LWPolyline/Line/Spline):")
   
7. (setq ss (ssget) m (sslength ss) n 0)
   
8. (command "_undo" "_be")
   
9. (command "_.ucs" "")
   
10. (while (< n m)
    
11. (setq en (ssname ss n) endt (entget en))
    
12. (setq ename (cdr (assoc 0 endt)))
    
13. (if (member ename (list "XLINE" "RAY"))
    
14. (progn
    
15. (setq pt10 (cdr (assoc 10 endt)) pt11 (cdr (assoc 11 endt)) ang (atan (/ (cadr pt11) (car pt11))))
    
16. (setq endt01 (subst (cons 10 (polar pt10 (+ ang (* 0.5 pi)) 10)) (assoc 10 endt) endt))
    
17. (entmake endt01)
    
18. (setq endt02 (subst (cons 10 (polar pt10 (- ang (* 0.5 pi)) 10)) (assoc 10 endt) endt))
    
19. (entmake endt02)
    
20. )
    
21. (progn
    
22. (setq obj (vlax-ename->vla-object en))
    
23. (vl-catch-all-apply '(lambda(xx)
    
24. (vla-offset xx 10)
    
25. (vla-offset xx -10)
    
26. )
    
27. (list obj)
    
28. )
    
29. )
    
30. )
    
31. (setq n (1+ n))
    
32. )
    
33. (setvar "osmode" old_os)
    
34. (command "_.ucs" "_p")
    
35. (command "_.undo" "_e")
    
36. (setvar "cmdecho" 1)
    
37. (princ)
    
38. )

(vl-load-com)<br /> (defun c:of2(/ old_os ss m n en obj)<br /> (setq old_os (getvar "osmode"))<br /> (setvar "osmode" 0)<br /> (setvar "cmdecho" 0)<br /> (princ "\nSelect a line(LWPolyline/Line/Spline):")<br /> (setq ss (ssget) m (sslength ss) n 0)<br /> (command "_undo" "_be")<br /> (command "_.ucs" "")<br /> (while (< n m)<br /> (setq en (ssname ss n) endt (entget en))<br /> (setq ename (cdr (assoc 0 endt)))<br /> (if (member ename (list "XLINE" "RAY"))<br /> (progn<br /> (setq pt10 (cdr (assoc 10 endt)) pt11 (cdr (assoc 11 endt)) ang (atan (/ (cadr pt11) (car pt11))))<br /> (setq endt01 (subst (cons 10 (polar pt10 (+ ang (* 0.5 pi)) 10)) (assoc 10 endt) endt))<br /> (entmake endt01)<br /> (setq endt02 (subst (cons 10 (polar pt10 (- ang (* 0.5 pi)) 10)) (assoc 10 endt) endt))<br /> (entmake endt02)<br /> )<br /> (progn<br /> (setq obj (vlax-ename->vla-object en))<br /> (vl-catch-all-apply '(lambda(xx)<br /> (vla-offset xx 10)<br /> (vla-offset xx -10)<br /> )<br /> (list obj)<br /> )<br /> )<br /> )<br /> (setq n (1+ n))<br /> )<br /> (setvar "osmode" old_os)<br /> (command "_.ucs" "_p")<br /> (command "_.undo" "_e")<br /> (setvar "cmdecho" 1)<br /> (princ)<br /> )

vlisp2012

顶一下！！！！

logoin

我试试，以下代码没有调试过
.
(defun c:so()
(vl-load-com)
(setq lineObj (vlax-ename->vla-object (car (entsel))))
(vla-offset lineObj 10)
(vla-offset lineObj -10)
(princ)
)

monsterking

logoin 发表于 2012-8-24 23:38
我试试，以下代码没有调试过
.
(defun c:so()
(vl-load-com)
(setq lineObj (vlax-ename->vla-object (car (entsel))))
(vla-offset lineObj 10)
(vla-offset lineObj -10)
(princ)
)

这个强，谢谢你。还有谢谢大家的帮忙。

海盗曹

学习一下好代码~

519995995

logoin 发表于 2012-8-24 23:38
我试试，以下代码没有调试过
.
(defun c:so()

假如偏移后的线另指定图层呢，怎么改高手

AbnerXk

1. (defun c:tt (/ lineObj)
   
2.   (vl-load-com)
   
3.   (setq lineObj (vlax-ename->vla-object (car (entsel))))
   
4.   (vla-offset lineObj 10)
   
5.   (Vlax-Put-Property (vlax-ename->vla-object (entlast)) 'Layer 0)
   
6.   (vla-offset lineObj -10)
   
7.   (Vlax-Put-Property (vlax-ename->vla-object(entlast)) 'Layer 0)
   
8.   (princ)
   
9. )
   

(defun c:tt (/ lineObj)<br />   (vl-load-com)<br />   (setq lineObj (vlax-ename->vla-object (car (entsel))))<br />   (vla-offset lineObj 10)<br />   (Vlax-Put-Property (vlax-ename->vla-object (entlast)) 'Layer 0)<br />   (vla-offset lineObj -10)<br />   (Vlax-Put-Property (vlax-ename->vla-object(entlast)) 'Layer 0)<br />   (princ)<br /> )<br />

519995995

染指红颜_笑 发表于 2014-5-8 13:17

0 层以外的层好像不能双偏移，只能单偏移，并且出错。。麻烦改改啊，并且能不能实现这样的功能呢：直线偏移后连成一个闭合的矩形呢？

edata

注：单向偏移出多个对象的暂时不能改属性

1. ;;;;简单版双向偏移函数  2014-5-10
   
2. ;;;(sk_myoffset 距离 图元名  图层 颜色 线型 线宽)
   
3. ;;;(sk_myoffset2 偏移距离【数值】 图元名 图层【字符串】颜色【0-256 0=随块 256随层】线型【字符串，"bylayer"随层"byblock"随块】线宽【整数 -2~211 -2随块 -1 随层 211=2.11mm】)
   
4. (defun sk_myoffset2(sk_dist en sk_lay sk_color sk_lt sk_lw / OBJ OBJ-OFFSET OBJ-OFFSET1 OBJ-OFFSET2 P1 P2)            
   
5.       (if (and sk_dist en)
   
6.         (progn          
   
7.           (setq obj (vlax-ename->vla-object en))
   
8.           (vla-Highlight obj :vlax-true)
   
9.           (setq obj-offset1(vlax-invoke-method obj 'offset  sk_dist))
   
10.           (setq obj-offset2(vlax-invoke-method obj 'offset  (* sk_dist -1)))         
    
11.           (setq obj-offset1(vlax-safearray-get-element(vlax-variant-value obj-offset1) 0))
    
12.           (setq obj-offset2(vlax-safearray-get-element(vlax-variant-value obj-offset2) 0))               
    
13.           (if sk_lay (progn(vla-put-layer obj-offset1 sk_lay)(vla-put-layer obj-offset2 sk_lay)))
    
14.           (if sk_color (progn (vla-put-color obj-offset1 sk_color)(vla-put-color obj-offset2 sk_color)))
    
15.           (if sk_lt (progn (vla-put-linetype obj-offset1 sk_lt)(vla-put-linetype obj-offset2 sk_lt)))
    
16.           (if sk_lw (progn (vla-put-lineweight obj-offset1 sk_lw)(vla-put-lineweight obj-offset2 sk_lw)))
    
17.           )
    
18.         )
    
19.       (and obj (vla-Highlight obj :vlax-false))
    
20.   )
    
21. (defun c:o10()
    
22.   ;;(sk_myoffset2 偏移距离【数值】 图元名 图层【字符串】颜色【0-256 0=随块 256随层】线型【字符串，"bylayer"随层"byblock"随块】线宽【整数 -2~211 -2随块 -1 随层 211=2.11mm】
    
23.   (if(setq ss(ssget '((0 . "*line,arc,circle,ellipse"))))
    
24.     (while(setq en(ssname ss 0))
    
25.       (sk_myoffset2 10 en "0" 1 "bylayer" -1)
    
26.       (setq ss(ssdel en ss))
    
27.       )   
    
28.     )
    
29.   (princ)
    
30.   )

;;;;简单版双向偏移函数  2014-5-10 <br /> ;;;(sk_myoffset 距离 图元名  图层 颜色 线型 线宽)<br /> ;;;(sk_myoffset2 偏移距离【数值】 图元名 图层【字符串】颜色【0-256 0=随块 256随层】线型【字符串，"bylayer"随层"byblock"随块】线宽【整数 -2~211 -2随块 -1 随层 211=2.11mm】)<br /> (defun sk_myoffset2(sk_dist en sk_lay sk_color sk_lt sk_lw / OBJ OBJ-OFFSET OBJ-OFFSET1 OBJ-OFFSET2 P1 P2)            <br />       (if (and sk_dist en)<br />         (progn          <br />           (setq obj (vlax-ename->vla-object en))<br />           (vla-Highlight obj :vlax-true)<br />           (setq obj-offset1(vlax-invoke-method obj 'offset  sk_dist))<br />           (setq obj-offset2(vlax-invoke-method obj 'offset  (* sk_dist -1)))          <br />           (setq obj-offset1(vlax-safearray-get-element(vlax-variant-value obj-offset1) 0))<br />           (setq obj-offset2(vlax-safearray-get-element(vlax-variant-value obj-offset2) 0))                <br />           (if sk_lay (progn(vla-put-layer obj-offset1 sk_lay)(vla-put-layer obj-offset2 sk_lay)))<br />           (if sk_color (progn (vla-put-color obj-offset1 sk_color)(vla-put-color obj-offset2 sk_color)))<br />           (if sk_lt (progn (vla-put-linetype obj-offset1 sk_lt)(vla-put-linetype obj-offset2 sk_lt)))<br />           (if sk_lw (progn (vla-put-lineweight obj-offset1 sk_lw)(vla-put-lineweight obj-offset2 sk_lw)))<br />           )<br />         )<br />       (and obj (vla-Highlight obj :vlax-false))<br />   )<br /> (defun c:o10()<br />   ;;(sk_myoffset2 偏移距离【数值】 图元名 图层【字符串】颜色【0-256 0=随块 256随层】线型【字符串，"bylayer"随层"byblock"随块】线宽【整数 -2~211 -2随块 -1 随层 211=2.11mm】<br />   (if(setq ss(ssget '((0 . "*line,arc,circle,ellipse"))))<br />     (while(setq en(ssname ss 0))<br />       (sk_myoffset2 10 en "0" 1 "bylayer" -1)<br />       (setq ss(ssdel en ss))<br />       )    <br />     )<br />   (princ)<br />   )