lll7511 发表于 2005-10-31 16:58:00

会跟园变化而变化的园中心线

加载CCEN.LSP,用命令CCEN.

lll7511 发表于 2005-10-31 17:01:00

加载CCEN.LSP,用命令CCEN

lll7511 发表于 2005-10-31 17:03:00

<P>(defun C:CCEN ()<BR>&nbsp; <BR>&nbsp; ;(vl-cmdf "-linetype" "c" "mycenter" "" "user.lin" 5,-1,1,-1 "")<BR>&nbsp; ;(vl-cmdf "-layer" "m" "1" "l" "center" "" "c" "red" "1" "")<BR>&nbsp; (vl-load-com)<BR>&nbsp; (setq acadObject (vlax-get-acad-object))<BR>&nbsp; (setq acadDocument (vla-get-ActiveDocument acadObject))<BR>&nbsp; (setq mSpace (vla-get-ModelSpace acadDocument))<BR>&nbsp; (setq util (vla-get-Utility acadDocument))<BR>&nbsp; (setq lts (vla-get-Linetypes acadDocument))<BR>&nbsp; ;(setvar "CMDECHO" 0)<BR>&nbsp; (setq selsets (vla-get-SelectionSets acadDocument))</P>
<P>&nbsp; (setq i (vla-get-count selsets))<BR>&nbsp; (while (&gt; i 0)<BR>&nbsp;&nbsp;&nbsp; (setq sset(vla-item&nbsp; selsets 0))<BR>&nbsp;&nbsp;&nbsp; (vla-delete sset)<BR>&nbsp;&nbsp;&nbsp; (setq i (- i 1))<BR>&nbsp;&nbsp; )<BR>&nbsp; (setq sset (vla-add selsets "sset"))<BR>&nbsp; (vla-SelectOnScreen sset)<BR>&nbsp; (setq ssetcount (vla-get-count sset))<BR>&nbsp; (setq obj (vla-item sset (- 1 ssetcount)))<BR>&nbsp; (setq objname (vla-get-objectname obj))</P>
<P><BR>&nbsp; (while (and (vla-get-count sset) (/= objname "AcDbCircle") )<BR>&nbsp;&nbsp;&nbsp; (prompt "所选图素中至少有一非圆的图元，请再试一次，或按 ESC 结束！")<BR>&nbsp;&nbsp;&nbsp; (vla-clear sset)<BR>&nbsp;&nbsp;&nbsp; (vla-SelectOnScreen sset)<BR>&nbsp;&nbsp;&nbsp; (setq ssetcount (vla-get-count sset))<BR>&nbsp;&nbsp;&nbsp; (setq obj (vla-item sset (- ssetcount 1)))<BR>&nbsp;&nbsp;&nbsp; (setq objname (vla-get-objectname obj))</P>
<P>&nbsp; )<BR>&nbsp; (setq circ_d (vla-get-Radius obj))<BR>&nbsp; (setq circ_cen (vla-get-center obj))<BR>&nbsp; (setq pt (vla-PolarPoint util circ_cen 0 (+ 5 circ_d)))<BR>&nbsp; (setq line (vla-addline mspace circ_cen pt))<BR>&nbsp; (load-line-types "CENTER" "acad.lin")<BR>&nbsp;&nbsp; (vla-put-Linetype line "CENTER")<BR>&nbsp; (setq lts (/ circ_d 5))<BR>&nbsp; (vla-put-LinetypeScale line lts)<BR>&nbsp; (setq<BR>&nbsp;&nbsp;&nbsp; linearray (vla-ArrayPolar line 4 (/ (* pi 2 (1- 4)) 4) circ_cen)<BR>&nbsp; )</P>
<P>&nbsp; (vla-delete sset)<BR>&nbsp; (setq circleReactor<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (VLR-Object-Reactor<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (list obj)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; "Circle Reactor"<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; '((:VLR-modified . mark))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )</P>
<P>)<BR>(defun load-line-types (line-type file-name / tmp res)<BR>&nbsp; (if (and (setq tmp (vlax-get-acad-object))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq tmp (vla-get-activedocument tmp))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq tmp (vla-get-linetypes tmp))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (setq res (find-line-type line-type tmp))<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; res<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (progn<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vla-load tmp line-type file-name)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (if (vla-item tmp line-type)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (vla-item tmp line-type)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; nil<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp;&nbsp;&nbsp; nil<BR>&nbsp; )<BR>)<BR>(defun find-line-type (line-type line-type-collection / res)<BR>&nbsp; (setq line-type (strcase line-type))<BR>&nbsp; (vlax-for l-obj line-type-collection<BR>&nbsp;&nbsp;&nbsp; (if (= (strcase (vla-get-name l-obj)) line-type)<BR>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; (setq res l-obj)<BR>&nbsp;&nbsp;&nbsp; )<BR>&nbsp; )<BR>&nbsp; res<BR>)<BR>(defun mark (notifier-object reactor-object parameter-list)<BR>&nbsp; (vl-load-com)</P>
<P>&nbsp; (setq circ_d (vla-get-Radius obj))<BR>&nbsp; (setq circ_cen (vla-get-center obj))<BR>&nbsp; (setq pt (vla-PolarPoint util circ_cen 0 (+ 5 circ_d)))<BR>&nbsp; (vla-delete line)<BR>&nbsp; (setq linesafearray (vlax-variant-value linearray))<BR>&nbsp; (vla-delete (vlax-safearray-get-element linesafearray 0))<BR>&nbsp; (vla-delete (vlax-safearray-get-element linesafearray 1))<BR>&nbsp; (vla-delete (vlax-safearray-get-element linesafearray 2))<BR>&nbsp; (setq line (vla-addline mspace circ_cen pt))<BR>&nbsp; (load-line-types "CENTER" "acad.lin")<BR>&nbsp; (vla-put-Linetype line "CENTER")<BR>&nbsp; (setq lts (/ circ_d 5))<BR>&nbsp; (vla-put-LinetypeScale line lts)<BR>&nbsp; (setq<BR>&nbsp;&nbsp;&nbsp; linearray (vla-ArrayPolar line 4 (/ (* pi 2 (1- 4)) 4) circ_cen)<BR>&nbsp; )<BR>)<BR></P>

lll7511 发表于 2005-10-31 17:05:00

不知道什么原因，文件传不上来。

lll7511 发表于 2005-11-1 08:04:00

压缩后上传
页: [1]
查看完整版本: 会跟园变化而变化的园中心线