求助：怎样点取直线然后自动在两侧生成偏移10的直线？
本帖最后由 monsterking 于 2012-8-23 13:39 编辑各位好，小弟在制图中，用最多的命令是offset，遇到如题所说有情况时，正常情况下要做10个动作才能完成，请问怎样用autolisp编写一个程序，更快地完成这个工作，衷心谢谢各位。 (vl-load-com)
(defun c:of2(/ old_os ss m n en obj)
(setq old_os (getvar "osmode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(princ "\nSelect a line(LWPolyline/Line/Spline):")
(setq ss (ssget) m (sslength ss) n 0)
(command "_undo" "_be")
(command "_.ucs" "")
(while (< n m)
(setq en (ssname ss n) endt (entget en))
(setq ename (cdr (assoc 0 endt)))
(if (member ename (list "XLINE" "RAY"))
(progn
(setq pt10 (cdr (assoc 10 endt)) pt11 (cdr (assoc 11 endt)) ang (atan (/ (cadr pt11) (car pt11))))
(setq endt01 (subst (cons 10 (polar pt10 (+ ang (* 0.5 pi)) 10)) (assoc 10 endt) endt))
(entmake endt01)
(setq endt02 (subst (cons 10 (polar pt10 (- ang (* 0.5 pi)) 10)) (assoc 10 endt) endt))
(entmake endt02)
)
(progn
(setq obj (vlax-ename->vla-object en))
(vl-catch-all-apply '(lambda(xx)
(vla-offset xx 10)
(vla-offset xx -10)
)
(list obj)
)
)
)
(setq n (1+ n))
)
(setvar "osmode" old_os)
(command "_.ucs" "_p")
(command "_.undo" "_e")
(setvar "cmdecho" 1)
(princ)
) 顶一下！！！！ 本帖最后由 logoin 于 2012-8-24 23:40 编辑
我试试，以下代码没有调试过
.
(defun c:so()
(vl-load-com)
(setq lineObj (vlax-ename->vla-object (car (entsel))))
(vla-offset lineObj 10)
(vla-offset lineObj -10)
(princ)
)
本帖最后由 monsterking 于 2012-8-25 10:55 编辑
logoin 发表于 2012-8-24 23:38 static/image/common/back.gif
我试试，以下代码没有调试过
.
(defun c:so()
(vl-load-com)
(setq lineObj (vlax-ename->vla-object (car (entsel))))
(vla-offset lineObj 10)
(vla-offset lineObj -10)
(princ)
)
这个强，谢谢你。还有谢谢大家的帮忙。 学习一下好代码~ logoin 发表于 2012-8-24 23:38 static/image/common/back.gif
我试试，以下代码没有调试过
.
(defun c:so()
假如偏移后的线另指定图层呢，怎么改高手 (defun c:tt (/ lineObj)
(vl-load-com)
(setq lineObj (vlax-ename->vla-object (car (entsel))))
(vla-offset lineObj 10)
(Vlax-Put-Property (vlax-ename->vla-object (entlast)) 'Layer 0)
(vla-offset lineObj -10)
(Vlax-Put-Property (vlax-ename->vla-object(entlast)) 'Layer 0)
(princ)
)
染指红颜_笑 发表于 2014-5-8 13:17 static/image/common/back.gif
0 层以外的层好像不能双偏移，只能单偏移，并且出错。。麻烦改改啊，并且能不能实现这样的功能呢：直线偏移后连成一个闭合的矩形呢？ 注：单向偏移出多个对象的暂时不能改属性
;;;;简单版双向偏移函数2014-5-10
;;;(sk_myoffset 距离 图元名图层 颜色 线型 线宽)
;;;(sk_myoffset2 偏移距离【数值】 图元名 图层【字符串】颜色【0-256 0=随块 256随层】线型【字符串，"bylayer"随层"byblock"随块】线宽【整数 -2~211 -2随块 -1 随层 211=2.11mm】)
(defun sk_myoffset2(sk_dist en sk_lay sk_color sk_lt sk_lw / OBJ OBJ-OFFSET OBJ-OFFSET1 OBJ-OFFSET2 P1 P2)
(if (and sk_dist en)
(progn
(setq obj (vlax-ename->vla-object en))
(vla-Highlight obj :vlax-true)
(setq obj-offset1(vlax-invoke-method obj 'offsetsk_dist))
(setq obj-offset2(vlax-invoke-method obj 'offset(* sk_dist -1)))
(setq obj-offset1(vlax-safearray-get-element(vlax-variant-value obj-offset1) 0))
(setq obj-offset2(vlax-safearray-get-element(vlax-variant-value obj-offset2) 0))
(if sk_lay (progn(vla-put-layer obj-offset1 sk_lay)(vla-put-layer obj-offset2 sk_lay)))
(if sk_color (progn (vla-put-color obj-offset1 sk_color)(vla-put-color obj-offset2 sk_color)))
(if sk_lt (progn (vla-put-linetype obj-offset1 sk_lt)(vla-put-linetype obj-offset2 sk_lt)))
(if sk_lw (progn (vla-put-lineweight obj-offset1 sk_lw)(vla-put-lineweight obj-offset2 sk_lw)))
)
)
(and obj (vla-Highlight obj :vlax-false))
)
(defun c:o10()
;;(sk_myoffset2 偏移距离【数值】 图元名 图层【字符串】颜色【0-256 0=随块 256随层】线型【字符串，"bylayer"随层"byblock"随块】线宽【整数 -2~211 -2随块 -1 随层 211=2.11mm】
(if(setq ss(ssget '((0 . "*line,arc,circle,ellipse"))))
(while(setq en(ssname ss 0))
(sk_myoffset2 10 en "0" 1 "bylayer" -1)
(setq ss(ssdel en ss))
)
)
(princ)
)
页:
[1]