3stone 发表于 2004-2-9 10:31:00

[单线变双线，并保留原线]

[单线变双线，并保留原线]实现变道路的中心线为道路双线


如何实现下列功能：选中一条直线L（线型为虚线），以此线L为中心，各向两边OFFSET，距离直线L均为a，OFFSET后生成的两条线为实线（CONTINUIOUS），原直线L不变。

无痕 发表于 2004-2-10 01:21:00

(defun c:x2 (/ ss vss dist)
   (princ "\n单线变双v.1.1-------by 无痕.2004.2\n选择要变双的曲线:")
   (setq ss (ssget   '((0 . "*line,arc,ellipse,circle")) )
vss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
               dist (getdist "\n输入偏移距离:"))
   (vlax-for obj vss (vla-offset obj dist)(vla-offset obj (- 0 dist)))
)

龙龙仔 发表于 2004-2-9 12:40:00

用VLISP中的OFFSET方法

ljcgq 发表于 2004-2-9 21:23:00

;线段双向偏移<BR>;ljc.2004.2<BR>(DEFUN C:OO( / qd zd       name2 ss qd1 zd1 CD tc os cdq )<BR>                                                                       (setq os(getvar "osmode"))<BR>                                                                       (command "osnap" "off")<BR>                                                                       (setq cd(getint "请输入偏移距离:"))<BR>                                                                       (if (= cd nil) (SETQ CD CCD))<BR>                                                                       (setq ss (ssget       '((0 . "LINE")) ) ) <BR>                                                                       (print "请选择线段:")<BR>                                                                       (SETQ N (SSLENGTH SS))<BR>                                                                       (SETQ A (- N 1))<BR>                                                               (REPEAT N<BR>                                                                       (setq name(ssname ss A))<BR>                                                                       (setq q(entget name))<BR>                                                                       (setq Zd (cdr(assoc 11 q))       qd (cdr(assoc 10 q)) )<BR>                                                                       (SETQ ANG (ANGLE QD ZD))<BR>                                                                       (SETQ       qdz (polar qd (+ ANG ( / PI 2)) cd)       qdy (polar qd (- ANG ( / PI 2)) cd))<BR>                                                                       (command "offset"       cd       name qdz       "")<BR>                                                                       (command "change" (entlast)       "" "p"       "lt" "CONTINUOUS" "" "")<BR>                                                                       (command "offset"       cd       name qdy "")<BR>                                                                       (command "change" (entlast) ""       "p" "lt"       "CONTINUOUS" "" "")<BR>                                                                       (command)<BR>                                                                       (SETQ       A (- A 1))<BR>                                                       )<BR>                                                       (SETQ CCD CD)<BR>                                                       (setvar "osmode" os)<BR>                                                                       <BR>)

myfreemind 发表于 2004-2-9 21:53:00

好程序~~画路边线就简单了！

kaixin119 发表于 2004-2-9 22:04:00

高手能不能把程序扩展一下,让它能使用于其它的线:       pline.....

BDYCAD 发表于 2004-2-10 09:08:00

樓上的這個是我目前見到最簡短的.

ljcgq 发表于 2004-2-10 12:45:00

命令: _appload 已成功加载 x2.lsp。


<BR>命令:<BR>命令:


命令: x2


单线变双v.1.1-------by 无痕.2004.2<BR>选择要变双的曲线:<BR>选择对象: 指定对角点: 找到 6 个


选择对象:<BR>; 错误: no function definition: VLAX-GET-ACAD-OBJECT


<BR>这是什么原因?

kaixin119 发表于 2004-2-10 13:00:00

谢谢无痕的帮助!!

无痕 发表于 2004-2-10 13:26:00

ljcgq发表于2004-2-10 12:45:00static/image/common/back.gif命令: _appload 已成功加载 x2.lsp。命令:命令:命令: x2单线变双v.1.1-------by 无痕.2004.2选择要变双的曲线:选择对象: 指定对角点...先运行(vl-load-com)。改一下过滤，重贴(defun c:x2 (/ ss vss dist)   (vl-load-com)
   (princ "\n单线变双v.1.1-------by 无痕.2004.2\n选择要变双的曲线:")
   (setq ss (ssget   '((0 . "Arc,Circle,Ellipse,Line,LwPolyline,Polyline,Spline,XLine")) )
vss (vla-get-activeselectionset (vla-get-activedocument (vlax-get-acad-object)))
               dist (getdist "\n输入偏移距离:"))
   (vlax-for obj vss (vla-offset obj dist)(vla-offset obj (- 0 dist)))
)
页: [1] 2 3
查看完整版本: [单线变双线，并保留原线]