[求助]怎样标注这个cad多边形的顶点坐标和各边长、多边形内角度数和面积？谢谢

Ronaldinho · 发表于 2005-1-24 16:37:00

我碰到个问题，手里有一大批需要标注坐标、角度、边长和面积的dwg文件，我lisp学得不好，短时间还写不出来它，而现在却要急用。请您百忙之中帮个忙。谢谢！

王咣生 · 发表于 2005-1-26 12:36:00

把它标注成什么样子呢?

王咣生 · 发表于 2005-1-29 22:17:00

做好了吗?

王咣生 · 发表于 2005-1-29 22:23:00

写好了吗?

Ronaldinho · 发表于 2005-1-29 22:23:00

还没呢!

xyp1964 · 发表于 2005-1-30 11:30:00

是否都是六边形？每点、每条边和每个角是否都要标注？

Ronaldinho · 发表于 2005-1-30 23:13:00

不都是六边行.都要注.

王咣生 · 发表于 2005-2-5 00:25:00

未成形代码: (vl-load-com)
(defun c:bz ( / ent ename strtype lst0 lst1 lst2)
(setq ent (entsel "\nSelect an pline: "))
(while (not ent)
(setq ent (entsel "\nSelect an pline: "))
)
(setq ename (car ent))

(setq strtype (cdr (assoc 0 (entget ename))))
(if (or (= (strcase strtype) "LWPOLYLINE") (= (strcase strtype) "POLYLINE"))
(progn
(setq lst0 (getVertextList ename))
;求质心 ;标坐标
(foreach vertex lst0
(setq str (strcat "(" (rtos (car vertex) 2 2) "," (rtos (cadr vertex) 2 2) ")" ))
(setq ptt (append vertex '(0)))
(vlex-AddText str ptt "MC" "STANDARD" 0.25 1.0 0 (getvar "clayer") nil)
);foreach
;标边长
(setq i 0)
(setq p0 (car lst0))
(while (<= i (length lst0))
(setq p0 (nth i lst0)
p1 (nth (+ i 1) lst0))
(if (= i (length lst0))
(progn
(setq p0 (car lst0)
p1 (car (reverse lst0)))
);
);if (setq ang (RTD (angle p0 p1)))
(setq pos (list (/ (+ (car p0)(car p1)) 2) (/ (+ (cadr p0)(cadr p1)) 2) 0))
(setq dist (rtos (distance p0 p1) 2 2))
(vlex-AddText dist pos "MC" "STANDARD" 0.25 1.0 ang (getvar "clayer") nil)

(setq i (+ i 1))
);while

);progn
(alert "That's not a 'LWPOLYLINE' or 'POLYLINE' entity.")
);if

;

(princ)
) (defun getVertextList (ename / item lst coords)
(setq item (vlax-ename->vla-object ename))
;取得多义线坐标
(setq lst (vlax-safearray->list
(vlax-variant-value
(vlax-get-property item 'Coordinates))
)
)

(setq coords nil)
(if (= (vlax-get-property item 'ObjectName) "AcDb2dPolyline")
(progn
(while lst
(if (= coords nil)
(setq coords (list (list (nth 0 lst) (nth 1 lst))) )
(setq coords (append coords (list (list (nth 0 lst) (nth 1 lst)))))
)
(setq lst (cdr (cdr (cdr lst))))
)
)
)

(if (= (vlax-get-property item 'ObjectName) "AcDbPolyline")
(progn
(while lst
(if (= coords nil)
(setq coords (list (list (nth 0 lst) (nth 1 lst))) )
(setq coords (append coords (list (list (nth 0 lst) (nth 1 lst)))))
)
(setq lst (cdr (cdr lst)))
)
)
)
coords
)
;;; EXAMPLE: (vlex-AddText "ABC" p1 "MC" "STANDARD" 0.25 1.0 0 "TEXT" nil) ;;;
(defun vlex-AddText
(strTxt pt Just strStyle dblHgt dblWid dblRot strLay intCol / txtobj)
(cond
( (setq txtobj
(vla-AddText
(vlex-ActiveSpace)
strTxt
(if (not (member (strcase Just) '("A" "F")))
(vlax-3d-Point pt)
(vlax-3d-Point (car pt))
); endif
dblHgt ;; ignored if Just = "A" (aligned)
)
)
(vla-put-StyleName txtobj strStyle)
(vla-put-Layer txtobj strLay)
(if intCol (vla-put-Color txtobj intCol))
(setq Just (strcase Just)) ;; force to upper case for comparisons...

;; Left/Align/Fit/Center/Middle/Right/BL/BC/BR/ML/MC/MR/TL/TC/TR
;; Note that "Left" is not a normal default.
;;
;; ALIGNMENT TYPES...
;; AcAlignmentLeft=0
;; AcAlignmentCenter=1
;; AcAlignmentRight=2
;; AcAlignmentAligned=3
;; AcAlignmentMiddle=4
;; AcAlignmentFit=5
;; AcAlignmentTopLeft=6
;; AcAlignmentTopCenter=7
;; AcAlignmentTopRight=8
;; AcAlignmentMiddleLeft=9
;; AcAlignmentMiddleCenter=10
;; AcAlignmentMiddleRight=11
;; AcAlignmentBottomLeft=12
;; AcAlignmentBottomCenter=13
;; AcAlignmentBottomRight=14
;;
;; HORIZONTAL JUSTIFICATIONS...
;; AcHorizontalAlignmentLeft=0
;; AcHorizontalAlignmentCenter=1
;; AcHorizontalAlignmentRight=2
;; AcHorizontalAlignmentAligned=3
;; AcHorizontalAlignmentMiddle=4
;; AcHorizontalAlignmentFit=5
;;
;; VERTICAL JUSTIFICATIONS...
;; AcVerticalAlignmentBaseline=0
;; AcVerticalAlignmentBottom=1
;; AcVerticalAlignmentMiddle=2
;; AcVerticalAlignmentTop=3 (cond
( (= Just "L") ;; Left
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "C") ;; Center
(vla-put-Alignment txtobj 1)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "R") ;; Right
(vla-put-Alignment txtobj 2)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "A") ;; Alignment
(vla-put-Alignment txtobj 3)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
)
( (= Just "M") ;; Middle
(vla-put-Alignment txtobj 4)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "F") ;; Fit
(vla-put-Alignment txtobj 5)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
)
( (= Just "TL") ;; Top-Left
(vla-put-Alignment txtobj 6)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "TC") ;; Top-Center
(vla-put-Alignment txtobj 7)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "TR") ;; Top-Right
(vla-put-Alignment txtobj 8)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "ML");; Middle-Left
(vla-put-Alignment txtobj 9)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "MC");; Middle-Center
(vla-put-Alignment txtobj 10)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "MR");; Middle-Right
(vla-put-Alignment txtobj 11)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "BL");; Bottom-Left
(vla-put-Alignment txtobj 12)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "BC");; Bottom-Center
(vla-put-Alignment txtobj 13)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
( (= Just "BR");; Bottom-Right
(vla-put-Alignment txtobj 14)
(vla-put-TextAlignmentPoint txtobj (vlax-3d-point pt))
(vla-put-ScaleFactor txtobj dblWid)
(vla-put-Rotation txtobj (DTR dblRot))
)
)
(vla-Update txtobj)
(vlax-Release-Object txtobj)
(entlast)
);
); cond
) (vl-Load-COM);; load ActiveX support in Visual LISP ;;; *********************** < First Session > ***********************;;; ;;;***************************************************************************;;;
;;; MODULE: vlex-AcadObject () ;;;
;;; DESCRIPTION: Returns COM handle to application object ;;;
;;; ARGS: none ;;;
;;; EXAMPLE: (vlex-AcadObject) returns ActiveX object ;;;
;;;***************************************************************************;;; (setq *acad-object* nil) ; Initialize global variable
(defun vlex-AcadObject ()
(cond (*acad-object*) ; Return the cached object
(T
(setq *acad-object* (vlax-Get-Acad-Object))
)
)
) ;;;***************************************************************************;;;
;;; MODULE: vlex-ActiveDocument () ;;;
;;; DESCRIPTION: Returns active document object from application object ;;;
;;; ARGS: none ;;;
;;; EXAMPLE: (vlex-ActiveDocument) returns ActiveX object ;;;
;;;***************************************************************************;;; (setq *vlex-ActiveDocument* nil) ; Initialize global variable
(defun vlex-ActiveDocument ()
(cond (*vlex-ActiveDocument*) ; Return the cached object
(T
(setq *vlex-ActiveDocument* (vla-Get-ActiveDocument (vlex-AcadObject)))
)
)
) ;;;***************************************************************************;;;
;;; MODULE: vlex-ModelSpace () ;;;
;;; DESCRIPTION: Returns vlex-ModelSpace collection object of active document ;;;
;;; ARGS: none ;;;
;;; EXAMPLE: (vlex-ModelSpace) returns ActiveX object ;;;
;;;***************************************************************************;;; (setq *vlex-ModelSpace* nil) ; Initialize global variable
(defun vlex-ModelSpace ()
(cond (*vlex-ModelSpace*) ; Return the cached object
(T
(setq *vlex-ModelSpace* (vla-Get-ModelSpace (vlex-ActiveDocument)))
)
)
)
;;;***************************************************************************;;;
;;; MODULE: vlex-PaperSpace ;;;
;;; DESCRIPTION: Returns paper-space collection object of active document ;;;
;;; ARGS: none ;;;
;;; EXAMPLE: (vlex-PaperSpace) returns ActiveX object ;;;
;;;***************************************************************************;;; (setq *vlex-PaperSpace* nil) ; Intialize global variable
(defun vlex-PaperSpace ()
(cond (*vlex-PaperSpace*) ; Return the cached object
(T
(setq *vlex-PaperSpace* (vla-Get-PaperSpace (vlex-ActiveDocument)))
)
)
) (defun vlex-ActiveSpace ()
(if (= 1 (vlax-get-Property (vlex-ActiveDocument) 'ActiveSpace))
(vlex-ModelSpace)
(vlex-PaperSpace)
); endif
) (defun DTR (a) (* pi (/ a 180.0)) )
(defun RTD (a) (/ (* a 180.0) pi) )

王咣生 · 发表于 2005-2-23 14:09:00

(vl-load-com)

(defun c:test ( / sset) ; 选择所有POLYLINE和LWPOLYLINE (setq sset (ssget "x" (list (cons -4 "<or")(cons 0 "

OLYLINE")(cons 0 "LWPOLYLINE")(cons -4 "or>")))) (if sset (progn (setq slen (sslength sset) idx 0) (repeat slen (setq en (ssname sset idx)) ;转换为Vla-Object类型对象 (setq plobj (MakeObject en)) ;得到坐标表 (setq plvers (GetVertexs plobj) plvers (Settle plvers))

(setq AcadObject (vlax-get-acad-object) AcadDocument (vla-get-ActiveDocument AcadObject) mSpace (vla-get-ModelSpace AcadDocument) ) ;建立字体 (setq TextStyleColl (vlax-get-property AcadDocument 'TextStyles)) (if (not (member "等线体" (ListCollectionMemberNames TextStyleColl))) (Progn (command "style" "等线体" "宋体" 1 1 0 "N" "N") ) );if

; (1) - 标注面积 (vlax-put-property plobj 'Closed :vlax-True) (vla-Update plobj) (setq curves (vlax-make-safearray vlax-vbobject '(0 . 0))) (vlax-safearray-fill curves (list plobj)) (setq regionObj (vlax-safearray-get-element (vlax-variant-value (vla-AddRegion mSpace curves)) 0 ) ) (setq area (vlax-get-property regionObj 'Area)) ;质心坐标 (setq centroid (vlax-safearray->list (vlax-variant-value (vlax-get-property regionObj 'Centroid))))

(command "text" "s" "等线体" centroid 1 0 (rtos area 2 2)) ;删除region对象 ;;; (vlax-dump-object regionObj t) (vlax-invoke-method regionObj 'Delete) (vlax-release-object regionObj) ; (2) - 边长标注 (setq offsetObj1 (vla-Offset plobj 1) offsetObj2 (vla-Offset plobj -1) offsetObj1 (vlax-safearray-get-element (vlax-variant-value offsetObj1) 0 ) area1 (vlax-get-property offsetObj1 'Area) offsetObj2 (vlax-safearray-get-element (vlax-variant-value offsetObj2) 0 ) area2 (vlax-get-property offsetObj2 'Area) ) (if (> area1 area) (setq offsetObj offsetObj1) (setq offsetObj offsetObj2) ) (setq offplvers (GetVertexs offsetObj) offplvers (Settle offplvers) ) (setq offplvers (append offplvers (list (car offplvers)))) ;为了起点与终点也标注

;删除offset对象 (vlax-invoke-method offsetObj1 'Delete) (vlax-invoke-method offsetObj2 'Delete)

;视区 (setq range (Extents offplvers)) (command "zoom" "w" (car range) (cadr range)) (setq pre (nth 0 offplvers) i 1) (while (setq cur (nth i offplvers)) (setq dist (distance pre cur) ang (RTD (angle pre cur)) ) (if (> dist 1.00) (progn (setq cen (list (/ (+ (car pre)(car cur)) 2) (/ (+ (cadr pre)(cadr cur)) 2))) (cond ( (or (and (>= ang 0) (<= ang 90)) (and (>= ang 270) (<= ang 360)) ) (command "text" "s" "等线体" "j" "MC" cen 1 ang (rtos dist 2 2)) ); ( (and (> ang 90) (< ang 270)) (setq ang (+ 180 ang)) (command "text" "s" "等线体" "j" "MC" cen 1 ang (rtos dist 2 2)) ) );cond ); );if (setq pre cur i (+ i 1)) );while ; ; (3) - 角度标注 (setq firtpt (car plvers) lastpt (car (reverse plvers)) i 0 ) (while (setq curpt (nth i plvers)) (setq polarPnt (vla-PolarPoint (vla-get-Utility AcadDocument) (vlax-3d-point curpt) (angle curpt centroid) (* (distance curpt centroid) 0.125)) ) (setq TextPoint polarPnt) (setq AngleVertex (vlax-3d-point curpt)) (cond ( (= i 0) (setq FirstEndPoint (vlax-3d-point lastpt) SecondEndPoint (vlax-3d-point (nth (+ i 1) plvers)) ) ); ( (= i (- (vl-list-length plvers) 1)) (setq FirstEndPoint (vlax-3d-point firtpt) SecondEndPoint (vlax-3d-point (nth (- (vl-list-length plvers) 2) plvers)) ) ); ( T (setq FirstEndPoint (vlax-3d-point (nth (- i 1) plvers)) SecondEndPoint (vlax-3d-point (nth (+ i 1) plvers)) ) ) );cond (setq DimAnguarObj (vla-AddDimAngular mSpace AngleVertex FirstEndPoint SecondEndPoint TextPoint)) (vlax-put-property DimAnguarObj 'TextHeight 0.6) (vla-Update DimAnguarObj) (setq i (+ i 1)) );while

; (4) - 添加坐标文本 ;;; (vlax-dump-object plobj T) (setq textWidth (abs (- (car (car range)) (car (cadr range))))) ;文字Just方式 (foreach each offplvers (cond ( (< (abs (- (car each) (car centroid))) (* textWidth 0.25)) (setq Just "MC") ); ( (> (car each) (car centroid)) (setq Just "BL") ); ( (< (car each) (car centroid)) (setq Just "BR") ); );cond (command "text" "s" "等线体" "j" Just each 0.8 0 (strcat "(" (rtos (car each) 2 2) "," (rtos (cadr each) 2 2) ")" )) (setq elast (entlast) elast (MakeObject elast) ) (vlax-put-property elast 'ScaleFactor 0.8) (vla-Update elast) );foreach ; (setq idx (+ idx 1)) );repeat );progn );if ;;; (alert (itoa (sslength sset))) )

; Converts an ENAME type into a Vla-Object (defun MakeObject (entname) (cond ( (= (type entname) 'ENAME) (vlax-ename->vla-object entname) ) ( (= (type entname) 'VLA-OBJECT) entname ) ) )

; 得到POLYLINE或LWPOLYLINE的坐标表 (defun GetVertexs (entname / tmplst coords) (setq plobj (MakeObject entname) coords '()) (setq pltyp (vlax-get-property plobj 'ObjectName)) (if (member pltyp '("AcDbPolyline" "AcDb2dPolyline")) (progn (setq tmplst (vlax-safearray->list (vlax-variant-value (vlax-get-property plobj 'Coordinates)))) (cond ( (= pltyp "AcDb2dPolyline")

olyline (while tmplst (setq coords (append coords (list (list (car tmplst) (cadr tmplst))))) (setq tmplst (cdddr tmplst)) );while ); ( (= pltyp "AcDbPolyline") ;LWPolyline (while tmplst (setq coords (append coords (list (list (car tmplst) (cadr tmplst))))) (setq tmplst (cddr tmplst)) );while ); );cond );progn );if coords )

(defun Settle (verlst / ret pre i) ;如果起点终点坐标相同,从坐标表中除去起点 (if (vl-every '= (car verlst) (car (reverse verlst))) (setq verlst (cadr verlst)) );if ;除去重复的结点 (setq ret (list (nth 0 verlst)) pre (nth 0 verlst) i 1) (while (setq cur (nth i verlst)) (if (not (vl-every '= cur pre)) (setq ret (append ret (list cur))) );if ; (setq i (+ i 1) pre cur) );while ret )

;返回集合对象中所有成员名称表 (defun ListCollectionMemberNames(collection / itemname out) (setq out '()) (vlax-for each collection (if (vlax-property-available-p each 'Name) (progn (setq itemname (vlax-get-property each 'Name) out (cons itemname out) ) ) ) ) (reverse out) )

;角度转换 (defun DTR (a) (* pi (/ a 180.0)) ) (defun RTD (a) (/ (* a 180.0) pi) )

;求坐标表的最大最小值 (defun Extents (plist /) (list (apply 'mapcar (cons 'min plist)) (apply 'mapcar (cons 'max plist)) ) )

Ronaldinho · 发表于 2005-2-23 15:47:00

多谢!!!多谢!!!鲜花!!!

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

[求助]怎样标注这个cad多边形的顶点坐标和各边长、多边形内角度数和面积？谢谢

本帖子中包含更多资源

reply

回复

reply

reply

本帖子中包含更多资源