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

lll7511

加载CCEN.LSP,用命令CCEN.

lll7511

加载CCEN.LSP,用命令CCEN

lll7511

(defun C:CCEN ()
 
  ;(vl-cmdf "-linetype" "c" "mycenter" "" "user.lin" 5,-1,1,-1 "")
  ;(vl-cmdf "-layer" "m" "1" "l" "center" "" "c" "red" "1" "")
  (vl-load-com)
  (setq acadObject (vlax-get-acad-object))
  (setq acadDocument (vla-get-ActiveDocument acadObject))
  (setq mSpace (vla-get-ModelSpace acadDocument))
  (setq util (vla-get-Utility acadDocument))
  (setq lts (vla-get-Linetypes acadDocument))
  ;(setvar "CMDECHO" 0)
  (setq selsets (vla-get-SelectionSets acadDocument))

  (setq i (vla-get-count selsets))
  (while (> i 0)
    (setq sset(vla-item  selsets 0))
    (vla-delete sset)
    (setq i (- i 1))
   )
  (setq sset (vla-add selsets "sset"))
  (vla-SelectOnScreen sset)
  (setq ssetcount (vla-get-count sset))
  (setq obj (vla-item sset (- 1 ssetcount)))
  (setq objname (vla-get-objectname obj))

  (while (and (vla-get-count sset) (/= objname "AcDbCircle") )
    (prompt "所选图素中至少有一非圆的图元，请再试一次，或按 ESC 结束！")
    (vla-clear sset)
    (vla-SelectOnScreen sset)
    (setq ssetcount (vla-get-count sset))
    (setq obj (vla-item sset (- ssetcount 1)))
    (setq objname (vla-get-objectname obj))

  )
  (setq circ_d (vla-get-Radius obj))
  (setq circ_cen (vla-get-center obj))
  (setq pt (vla-PolarPoint util circ_cen 0 (+ 5 circ_d)))
  (setq line (vla-addline mspace circ_cen pt))
  (load-line-types "CENTER" "acad.lin")
   (vla-put-Linetype line "CENTER")
  (setq lts (/ circ_d 5))
  (vla-put-LinetypeScale line lts)
  (setq
    linearray (vla-ArrayPolar line 4 (/ (* pi 2 (1- 4)) 4) circ_cen)
  )

  (vla-delete sset)
  (setq circleReactor
         (VLR-Object-Reactor
           (list obj)
           "Circle Reactor"
           '((:VLR-modified . mark))
         )
  )

)
(defun load-line-types (line-type file-name / tmp res)
  (if (and (setq tmp (vlax-get-acad-object))
           (setq tmp (vla-get-activedocument tmp))
           (setq tmp (vla-get-linetypes tmp))
      )
      (if (setq res (find-line-type line-type tmp))
      res
      (progn
        (vla-load tmp line-type file-name)
        (if (vla-item tmp line-type)
          (vla-item tmp line-type)
          nil
        )
      )
    )
    nil
  )
)
(defun find-line-type (line-type line-type-collection / res)
  (setq line-type (strcase line-type))
  (vlax-for l-obj line-type-collection
    (if (= (strcase (vla-get-name l-obj)) line-type)
      (setq res l-obj)
    )
  )
  res
)
(defun mark (notifier-object reactor-object parameter-list)
  (vl-load-com)

  (setq circ_d (vla-get-Radius obj))
  (setq circ_cen (vla-get-center obj))
  (setq pt (vla-PolarPoint util circ_cen 0 (+ 5 circ_d)))
  (vla-delete line)
  (setq linesafearray (vlax-variant-value linearray))
  (vla-delete (vlax-safearray-get-element linesafearray 0))
  (vla-delete (vlax-safearray-get-element linesafearray 1))
  (vla-delete (vlax-safearray-get-element linesafearray 2))
  (setq line (vla-addline mspace circ_cen pt))
  (load-line-types "CENTER" "acad.lin")
  (vla-put-Linetype line "CENTER")
  (setq lts (/ circ_d 5))
  (vla-put-LinetypeScale line lts)
  (setq
    linearray (vla-ArrayPolar line 4 (/ (* pi 2 (1- 4)) 4) circ_cen)
  )
)

lll7511

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

lll7511

压缩后上传