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

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

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

)

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。
命令:
命令:
命令: x2
单线变双v.1.1-------by 无痕.2004.2
选择要变双的曲线:
选择对象: 指定对角点: 找到 6 个
选择对象:
; 错误: no function definition: VLAX-GET-ACAD-OBJECT
这是什么原因?

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

谢谢无痕的帮助!!

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

先运行(vl-load-com)。改一下过滤，重贴

copy


(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)))
)

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

发表回复

精选推荐