[LISP]，各位高手请帮忙！

linlei8128 · 发表于 2005-4-21 17:32:00

各位高手：

你好！如何通过LISP获取一段线或圆弧的中间点？

有劳帮忙，多谢！

SWAYWOOD · 发表于 2005-4-21 17:47:00

这些基本的东西，论坛里都有，多搜索搜索

;;T. Tanzillo
(defun xplist (KEY LST)
(mapcar 'cdr
(vl-remove-if-not
'(lambda (E) (eq (car E) KEY))
LST
)
)
)
(defun c:plpt (/ ent entlist ptList)
(vl-load-com)
(setq ent (car (entsel)))
(setq entlist (entget ent))
(while (assoc 10 entlist)
(setq ptList (append ptList (list (cdr (assoc 10 entlist)))))
(setq entlist (vl-remove (assoc 10 entlist) entlist))
)
ptList
(mapcar '(lambda(e1 e2) (command "_.pline" e1 e2 "")) (reverse (cdr (reverse ptlist))) (cdr ptlist))
);将所选择的line或arc串成多义线(defun c:ddx (/ ssa ssa-ent ent-p i)
(command "undo" "be");设置返回起始点
(setq ssa (ssget))
(setq i 0)
(while (< i (sslength ssa))
(setq ssa-ent (ssname ssa i))
(setq ent-p (cdr(assoc 0 (entget ssa-ent))))
(if (not (null ent-p));判断原图元是否已串入多义线
(if (or (= ent-p "LWPOLYLINE") (= ent-p "POLYLINE"));判断原图元属性
(command "pedit" ssa-ent "j" ssa "" "")
(command "pedit" ssa-ent "y" "j" ssa "" "")
))
(setq i (1+ i))
)
(command "undo" "e");设置返回终止点
(princ)
)
;; By Richard L
;; Parker Hannifin Ltd (NZ).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 判断多义线是否3D多义线
(defun is3dpline (ename)
(setq obj (vlax-ename->vla-object ename))
(if (= (vla-get-objectname obj) "AcDb3dPolyline")
(setq 3d T)
(setq 3d nil)
)
3d
)
;; 判断多义线是否闭合
(defun isclosed (ename)
(setq obj (vlax-ename->vla-object ename))
(vla-get-closed obj)
)
;; 判断多义线是PLINE还是SPLINE
(defun plineorspline (ename)
(setq obj (vlax-ename->vla-object ename))
(cond
((or (= (vla-get-objectname obj) "AcDbPolyline")
(= (vla-get-objectname obj) "AcDb3dPolyline"))
(setq pl T))
((= (vla-get-objectname obj) "AcDbSpline")
(setq pl nil))
(T (alert "It is neither Polyline nor Spline! "))
)
pl
)
;; 返回多义线的面积
(defun getarea (ename)
(setq obj (vlax-ename->vla-object ename))
(vla-get-area obj)
);
; 返回多义线的各顶点
(defun vertexs (ename / plist pp n)
(setq obj (vlax-ename->vla-object ename))
(setq plist (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates obj))))
(setq n 0)
(repeat (/ (length plist) 2)
(setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))
(setq n (+ n 2))
)
pp
)
;;判断多义线是否有圆弧(凸度/=0)的子段
(defun checkarc (ename)
(setq obj (vlax-ename->vla-object ename))
(setq plist (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates obj))))
(setq n 0 bu nil)
(repeat (/ (length plist) 2)
(if (/= (vla-getbulge obj n) 0)
(setq bu T)
)
(setq n (+ n 1))
)
bu
)
;; 返回多义线子段的数量
(defun numbersofseg (ename)
(setq obj (vlax-ename->vla-object ename))
(setq plist (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates obj))))
(1- (/ (length plist) 2))
)
;; 返回多义线第n点的坐标
(defun coodsofnumpoint (ename n)
(setq obj (vlax-ename->vla-object ename))
(setq plist (vlax-safearray->list
(vlax-variant-value
(vla-get-coordinates obj))))
(list (nth (* n 2) plist)(nth (1+ (* n 2)) plist))
)
;; 返回多义线第n子段的端点坐标
(defun coodsofsegbynum (obj n)
(vlax-safearray->list
(vlax-variant-value
(vla-get-coordinate obj 2)))
)
;; 返回多义线所点击子段的端点坐标
(defun coordsofsegbypick (ename p)
(setq obj (vlax-ename->vla-object ename)
pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n (fix (vlax-curve-getparamatpoint obj pp)))
(segcoord obj n)
)
;;返回多义线第n个子段的长度
(defun lengthofsegbynum (ename n)
(setq obj (vlax-ename->vla-object ename))
(- (vlax-curve-getdistatparam obj (1+ n))
(vlax-curve-getdistatparam obj n))
);
;; 返回多义线所点击子段的长度
(defun lengthofseg (ename p)
(setq obj (vlax-ename->vla-object ename)
pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n (fix (vlax-curve-getparamatpoint obj pp)))
(- (vlax-curve-getdistatparam obj (1+ n))
(vlax-curve-getdistatparam obj n))
)
;;返回多义线第n个子段的宽度
(defun widthofsegbynum (ename n)
(setq obj (vlax-ename->vla-object ename))
(vla-getwidth obj n 'ws 'wd)
(list ws wd)
)
;; 返回多义线所点击子段的宽度
(defun widthofsegbypick (ename p)
(setq obj (vlax-ename->vla-object ename)
pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n (fix (vlax-curve-getparamatpoint obj pp)))
(vlax-invoke-method obj 'getwidth n 'ws 'wd)
(list ws wd)
);
;;COPY多义线所点击的子段
(defun segmentcopy (ename p)
(vl-cmdf "explode" ename "")
(vl-cmdf "copy" (ssget "c" (polar p (/ pi 4) 0.01)(polar p (* 1.25 pi) 0.01))
"" p (getpoint "\nSecond point:") "")
(setq entl (entget (entlast)))
(vl-cmdf "undo" 2 "")
(entmake (cdr entl))
)
;; OFFSET多义线所点击的子段
(defun segmentoffset (ename p)
(setq oo (getdist "\nValue of offset:"))
(vl-cmdf "explode" ename "")
(vl-cmdf "offset" oo p
; (ssname (ssget "c" (polar p (/ pi 4) 0.01)(polar p (* 1.25 pi) 0.01)) 0)
(getpoint "\nInput offset point:") "")
(setq entl (entget (entlast)))
(vl-cmdf "undo" 2 "")
(entmake (cdr entl))
)
;;修改多义线第n个子段的凸度
(defun bulgebynum (ename n)
(setq obj (vlax-ename->vla-object ename))
(setq bu (getreal "\nNew Bugle Value: "))
(vla-setbulge obj n bu)
)
;; 修改多义线所点击子段的凸度
(defun bulgebypick (ename p)
(setq obj (vlax-ename->vla-object ename)
pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n (fix (vlax-curve-getparamatpoint obj pp)))
(setq bu (getreal "\nNew Bugle Value: "))
(vla-setbulge obj n bu)
)
;; 给多义线添加顶点
(defun addvertex (ename p)
(setq obj (vlax-ename->vla-object ename)
pp (vlax-curve-getclosestpointto obj (trans p 1 0))
n (fix (vlax-curve-getparamatpoint obj pp))
pn (getpoint "\nPick a Point: ")
pn (list (car pn)(cadr pn))
newv (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 1)) pn))
(vla-addvertex obj (1+ n) newv)
)

;;T. Tanzillo
(defun xplist (KEY LST)
   (mapcar 'cdr
     (vl-remove-if-not
         '(lambda (E) (eq (car E) KEY))
         LST
     )
   )
)
(defun c:plpt (/ ent entlist ptList)
   (vl-load-com)
   (setq ent (car (entsel)))
   (setq entlist (entget ent))
   (while (assoc 10 entlist)
       (setq ptList (append ptList (list (cdr (assoc 10 entlist)))))
       (setq entlist (vl-remove (assoc 10 entlist) entlist))
   )
   ptList
(mapcar '(lambda(e1 e2) (command "_.pline" e1 e2 "")) (reverse (cdr (reverse ptlist))) (cdr ptlist))
   );将所选择的line或arc串成多义线(defun c:ddx (/ ssa ssa-ent ent-p i)
   (command "undo" "be");设置返回起始点
   (setq ssa (ssget))
   (setq i 0)
   (while (< i (sslength ssa))
       (setq ssa-ent (ssname ssa i))
       (setq ent-p (cdr(assoc 0 (entget ssa-ent))))
       (if (not (null ent-p));判断原图元是否已串入多义线
           (if (or (= ent-p "LWPOLYLINE") (= ent-p "POLYLINE"));判断原图元属性
                 (command "pedit" ssa-ent   "j" ssa "" "")
                 (command "pedit" ssa-ent   "y" "j" ssa "" "")
       ))
       (setq i (1+ i))
   )
   (command "undo" "e");设置返回终止点
   (princ)
)
;; By Richard L
;; Parker Hannifin Ltd (NZ).
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 判断多义线是否3D多义线
(defun is3dpline (ename)    
   (setq obj (vlax-ename->vla-object ename))
   (if (= (vla-get-objectname obj) "AcDb3dPolyline")
       (setq 3d T)
       (setq 3d nil)
   )
   3d
)
;; 判断多义线是否闭合
(defun isclosed (ename)                     
   (setq obj (vlax-ename->vla-object ename))
   (vla-get-closed obj) 
)
;; 判断多义线是PLINE还是SPLINE
(defun plineorspline (ename)    
   (setq obj (vlax-ename->vla-object ename))
   (cond
       ((or (= (vla-get-objectname obj) "AcDbPolyline")
                 (= (vla-get-objectname obj) "AcDb3dPolyline"))
           (setq pl T))
       ((= (vla-get-objectname obj) "AcDbSpline")
         (setq pl nil))
       (T (alert "It is neither Polyline nor Spline! "))
   )
   pl
)
;; 返回多义线的面积
(defun getarea (ename)  
   (setq obj (vlax-ename->vla-object ename))
   (vla-get-area obj)
);
; 返回多义线的各顶点
(defun vertexs (ename / plist pp n)               
   (setq obj (vlax-ename->vla-object ename))
   (setq plist (vlax-safearray->list
    (vlax-variant-value
       (vla-get-coordinates obj))))
   (setq n 0)
   (repeat (/ (length plist) 2)
       (setq pp (append pp (list (list (nth n plist)(nth (1+ n) plist)))))
       (setq n (+ n 2))
   )
   pp
)
;;判断多义线是否有圆弧(凸度/=0)的子段
(defun checkarc (ename)      
   (setq obj (vlax-ename->vla-object ename))
   (setq plist (vlax-safearray->list
    (vlax-variant-value
       (vla-get-coordinates obj))))
   (setq n 0 bu nil)
   (repeat (/ (length plist) 2)
       (if (/= (vla-getbulge obj n) 0)
           (setq bu T)
         )
       (setq n (+ n 1))
   )
   bu
)
;; 返回多义线子段的数量
(defun numbersofseg (ename)    
   (setq obj (vlax-ename->vla-object ename))
   (setq plist (vlax-safearray->list
    (vlax-variant-value
       (vla-get-coordinates obj))))
   (1- (/ (length plist) 2))
)
;; 返回多义线第n点的坐标
(defun coodsofnumpoint (ename n)
   (setq obj (vlax-ename->vla-object ename))
   (setq plist (vlax-safearray->list
    (vlax-variant-value
       (vla-get-coordinates obj))))
   (list (nth (* n 2) plist)(nth (1+ (* n 2)) plist))
)
;; 返回多义线第n子段的端点坐标
(defun coodsofsegbynum (obj n)    
   (vlax-safearray->list
                           (vlax-variant-value
                               (vla-get-coordinate obj 2)))
)
;; 返回多义线所点击子段的端点坐标
(defun coordsofsegbypick (ename p)    
   (setq obj (vlax-ename->vla-object ename)
                 pp (vlax-curve-getclosestpointto obj (trans p 1 0))
                   n (fix (vlax-curve-getparamatpoint obj pp)))
   (segcoord obj n)
)
;;返回多义线第n个子段的长度
  (defun lengthofsegbynum (ename n)    
   (setq obj (vlax-ename->vla-object ename))
   (- (vlax-curve-getdistatparam obj (1+ n))
         (vlax-curve-getdistatparam obj n))
);
;; 返回多义线所点击子段的长度
(defun lengthofseg (ename p)    
   (setq obj (vlax-ename->vla-object ename)
                 pp (vlax-curve-getclosestpointto obj (trans p 1 0))
                   n (fix (vlax-curve-getparamatpoint obj pp)))
   (- (vlax-curve-getdistatparam obj (1+ n))
         (vlax-curve-getdistatparam obj n))
)
;;返回多义线第n个子段的宽度
  (defun widthofsegbynum (ename n)    
   (setq obj (vlax-ename->vla-object ename))
   (vla-getwidth obj n 'ws 'wd) 
   (list ws wd) 
)
;; 返回多义线所点击子段的宽度
(defun widthofsegbypick (ename p)    
   (setq obj (vlax-ename->vla-object ename)
                 pp (vlax-curve-getclosestpointto obj (trans p 1 0))
                   n (fix (vlax-curve-getparamatpoint obj pp)))
   (vlax-invoke-method obj 'getwidth n 'ws 'wd)
   (list ws wd)
);
;;COPY多义线所点击的子段
(defun segmentcopy (ename p)    
   (vl-cmdf "explode" ename "")
   (vl-cmdf "copy" (ssget "c" (polar p (/ pi 4) 0.01)(polar p (* 1.25 pi) 0.01))
                       "" p (getpoint "\nSecond point:") "")
   (setq entl (entget (entlast)))
   (vl-cmdf "undo" 2 "")
   (entmake (cdr entl))
)
;; OFFSET多义线所点击的子段
(defun segmentoffset (ename p)       
   (setq oo (getdist "\nValue of offset:"))
   (vl-cmdf "explode" ename "")
   (vl-cmdf "offset" oo p
     ; (ssname (ssget "c" (polar p (/ pi 4) 0.01)(polar p (* 1.25 pi) 0.01)) 0)
           (getpoint "\nInput offset point:") "")
   (setq entl (entget (entlast)))
   (vl-cmdf "undo" 2 "")
   (entmake (cdr entl))
)
;;修改多义线第n个子段的凸度
(defun bulgebynum (ename n)    
   (setq obj (vlax-ename->vla-object ename))
   (setq   bu (getreal "\nNew Bugle Value: ")) 
   (vla-setbulge obj n bu)
)
;; 修改多义线所点击子段的凸度
(defun bulgebypick (ename p)    
   (setq obj (vlax-ename->vla-object ename)
                 pp (vlax-curve-getclosestpointto obj (trans p 1 0))
                   n (fix (vlax-curve-getparamatpoint obj pp)))
   (setq   bu (getreal "\nNew Bugle Value: "))
   (vla-setbulge obj n bu)
)
;; 给多义线添加顶点
(defun addvertex (ename p)                             
   (setq obj (vlax-ename->vla-object ename)
                 pp (vlax-curve-getclosestpointto obj (trans p 1 0))
                   n (fix (vlax-curve-getparamatpoint obj pp))
                 pn (getpoint "\nPick a Point: ")
                 pn (list (car pn)(cadr pn))
             newv (vlax-safearray-fill (vlax-make-safearray vlax-vbDouble '(0 . 1)) pn))
   (vla-addvertex obj (1+ n) newv) 
)

linlei8128 · 发表于 2005-4-21 18:10:00

侠之大者：

多谢！有没更简单的？

ljpnb · 发表于 2005-4-21 18:23:00

(defun c:test ()
(setq
splineobj (vlax-ename->vla-object (car (entsel "\n选择一物体:")))
)
(setq stparameter (vlax-curve-getStartParam splineObj))
(setq endparameter (vlax-curve-getEndParam splineObj))
(setq midpoint (vlax-curve-getPointAtParam
splineObj
(+ (/ (- endparameter stparameter) 2) stparameter)
)
)
(prompt "所选物体的中点坐标为: ")
(print midpoint)
(princ)
)

meflying · 发表于 2005-4-22 08:29:00

建议楼主好好看看2楼的东西,虽然我没有看到楼主要的中点程序(是不是我没看清楚?),不过这些东西比较实用的好东西啊,,,对楼主的学习也是有很大的帮助的

龙龙仔 · 发表于 2005-4-22 14:25:00

ljpnb发表于2005-4-21 18:23:00(defun c:test () (setq splineobj (vlax-ename->vla-object (car (entsel \"\n选择一物体:\"))) ) (setq stparameter (vlax-curve-getS...

改用距离会好一些,Param对某些线(ellipse弧)会不对

xushifu210 · 发表于 2005-4-24 10:07:00

厉害，有学到不少知识

晨韵 · 发表于 2005-4-25 01:27:00

请各位大侠帮忙！小弟刚学CAD不久，想求同一图层内的N条直线，进行累加求和！但苦于不知如何实现！还请多帮忙！

hoprich123 · 发表于 2005-4-25 15:00:00

(defun c:test( / ss l i ssn ssd p1 p2 d1 dt)

   (setq ss(ssget) l(sslength ss) i 0 dt 0.0)

   (repeat l

   (setq ssn(ssname ss i))

   (setq ssd(entget ssn))

   (if (= (cdr (assoc 0 ssd)) "LINE")

   (progn

   (setq p1(cdr (assoc 10 ssd)))

   (setq p2(cdr (assoc 11 ssd)))

   (setq d1(distance p1 p2))

   (setq dt(+ dt d1))

)

)

   (setq i(1+ i))

   )

   (princ (strcat "Total lengthen:" (rtos dt 2 3)))

   (prin1)

)

账号		自动登录	找回密码
密码			注册