[编程交流] 查找圆柱体的中心线

;; written by Hikolay Poleshuk
;; http://www.private.peterlink.ru/poleshchuk/cad/eng.html
(defun 3dsolidinfo (/ ae w wl1 wl1e wl2 wle wltemp wstr)
(setq ae (car (entsel "\nSelect a 3dSolid (cylinder):")))
(setq wle (entget ae))
(setq wl1e
(mapcar 'cdr (vl-remove-if-not
(function (lambda (w) (= 1 (car w))))
wle)))
(while wl1e
(setq wstr (car wl1e))
(setq wl1 (vl-string->list wstr))
(setq wl2
(mapcar
'(lambda (w)
(setq w (if (= w 32) 32 (boole 6 w 95)))
(if (< w 32) (setq w (+ w 64)) w)
)
wl1
)
)
(setq wltemp
(append wltemp (list (vl-list->string wl2))))
(setq wl1e (cdr wl1e))
)
wltemp
)
; by *** 2004
(defun strlist (strExp strDel / strLst)
 (while (setq pos (vl-string-position (ascii strDel) strExp))
   (setq itm (substr strExp 1 pos))
   (setq strLst (append strLst (list itm)))
   (setq strExp (substr strExp (+ pos 2)))
 )
 (setq strLst (append strLst (list strExp)))
)
(defun C:test(/ axis_points info p1 p2)
(setq info (3dsolidinfo))
(setq axis_points
(mapcar        (function
  (lambda (n)
    (cdddr (mapcar 'atof (strlist n " ")))))
(mapcar        (function (lambda (s) (substr s 18)))
        (vl-remove-if-not
          (function (lambda (x) (wcmatch x "ellipse-curve $*")))
          info))))
(setq p1 (car axis_points)
     p2 (cadr axis_points)
     p1 (list (car p1)(cadr p1)(caddr p1))
     p2 (list (car p2)(cadr p2)(caddr p2))
     )
(alert (strcat "Height of cylinder = " (rtos (distance p1 p2)) " drawing units"))
 (princ)
 )

(defun c:test2 ( / ss1)
 ;; Create 3 cylinders, one of which is shaped to fit the other two.  
 (command ".ucs" "W")
 ;; Create the two chord cylinders (that will be subtracted).
 (command ".cylinder" "0,0,0" 2.0 10.0)
 (setq ss1 (ssadd (entlast)))
 (command ".cylinder" "10,0,0" 1.0 10.0)
 (ssadd (entlast) ss1)
 
 (command ".vpoint" "1,-1,1")
 
 ;; Create the cylinders and fit the ends to the first two cylinders.
 (command ".ucs" "ZA" "10,0,2" "0,0,8")
 (command ".color" "r")
 (command ".cylinder" "0,0,0" 1.0 11.66190379)
 ;; Cope both ends to fit the chord cylinders.
 (command ".subtract" (entlast) "" ss1 "")
 ;; Recreate the two cylinders deleted by the subtract command.
 (command ".ucs" "W")
 (command ".color" "y")
 (command ".cylinder" "0,0,0" 2.0 10.0)
 (command ".cylinder" "10,0,0" 1.0 10.0)
 (command ".color" "w")
 (alert "Try the 'test' command on the red cylinder.  It reports the height of the cylinder is 0.0 units and p1 and p2 are identical.")
) ;_ defun c:test2