各位高手看看怎么复制不了
(defun c:fv(/ mydoc myhndl myobj llpoint urpoint);提取容方框的角点(vl-load-com)
(setq mydoc(vla-get-activedocument (vlax-get-acad-object)))
(SETQ BLKEN (car (entsel "\n选择图框:")))
(setq myhndl(cdr (assoc 5(entget BLKEN))))
(setq blkobj (vlax-ename->vla-object BLKEN));;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq blkn (vla-get-name blkobj))
(setq xvar (vla-GetAttributes blkobj))
(setq svar (vlax-variant-value xvar))
(setq PX (vla-get-XScaleFactor blkobj));X比例
(setq PY (vla-get-YScaleFactor blkobj));y比例
(setq PZ (vla-get-ZScaleFactor blkobj));z比例
(SETQ BL(* PY 1000))
(SETQ CAR40 (* 3 PY))
(IF (= PY PX)
(SETQ BL (* PY 1000)))
(setq BLQ1 (strcase "1:"))
(SETQ BLQ2 (RTOS BL 2 0))
(setq BLQ (strcat BLQ1 BLQ2))
(setq att_obj_list (vlax-safearray->list svar))
(foreach obj att_obj_list
(setq tag (vla-get-tagstring obj))
(setq val (vla-get-textstring obj))
(setq str1 (strcat tag "\t" val))
(if (= tag "证件类型" ) (setq aa1 val))
(if (= tag "登记字号" ) (setq aa2 val))
(if (= tag "证载占地面积" ) (setq aa3 val))
(if (= tag "证载建筑面积" ) (setq aa4 val))
(if (= tag "证层数" ) (setq aa5 val))
(if (= tag "证结构" ) (setq aa6 val))
(if (= tag "坐落地址" ) (setq aa7 val))
(if (= tag"备注") (setqaa8 val))
(setq att_tab_list (cons str1 att_tab_list))
(setq myobj(vla-handletoobject mydoc myhndl))
(setq err(vl-catch-all-apply 'vla-GetBoundingBox (list myobj 'llpoint 'urpoint)))
;(if (vl-catch-all-error-p err)
; (princ "\n不能为所选图元建立包容方框，程序退出!")
; ; (progn
; (setq p1(vlax-safearray->list llpoint));提取minpoint坐标
;(setq p2(vlax-safearray->list urpoint));提取minpoint坐标
; )
;)
;(COMMAND "ZOOM" "W" P1 P2);;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;生成完毕后在正中显示
;(princ val )
(dfggg)
;(princ "\n已完成！请检查！")
;(prin1)
))
(defun dfggg();块属性数据修改
(vl-load-com)
(SETQ ENK NIL)
(SETQ ENK (car (entsel "\n选择要修改的附图图框:")))
(setq Block_obj (vlax-ename->vla-object ENK))
(setq blkn (vla-get-name Block_OBJ))
(setq New_BXVAR (vla-GetAttributes Block_OBJ))
(setq Block_svar (vlax-variant-value New_BXVAR))
(setq Block_obj_list (vlax-safearray->list Block_svar))
(foreach Block_obj Block_obj_list
(setq tag (vla-get-tagstring Block_obj))
(setq va2 (vla-get-textstring Block_obj))
(setq Block_str (strcat tag "\t" val))
(setq Block_tab_list (cons Block_str Block_tab_list))
(setq att_data_list(cons (list tag val) att_data_list))
;--------------------------------------------------------------
(SETQ New_tag1 "证件类型")
(setq bb1 aa1)
(foreach Block_obj Block_obj_list
(if (= (vla-get-tagstring Block_obj) New_tag1)
(vla-put-textstring Block_obj bb1)
)
)
(SETQ New_tag1 "登记字号")
(setq bb2 aa2)
(foreach Block_obj Block_obj_list
(if (= (vla-get-tagstring Block_obj) New_tag1)
(vla-put-textstring Block_obj bb2)
)
)
(SETQ New_tag1 "证载占地面积")
(setq bb3 aa3)
(foreach Block_obj Block_obj_list
(if (= (vla-get-tagstring Block_obj) New_tag1)
(vla-put-textstring Block_obj bb3)
)
)
(SETQ New_tag1 "证载建筑面积")
(setq bb4 aa4)
(foreach Block_obj Block_obj_list
(if (= (vla-get-tagstring Block_obj) New_tag1)
(vla-put-textstring Block_obj bb4)
)
)
(SETQ New_tag1 "证层数")
(setq bb5 aa5)
(foreach Block_obj Block_obj_list
(if (= (vla-get-tagstring Block_obj) New_tag1)
(vla-put-textstring Block_obj bb5)
)
)
(SETQ New_tag1 "证结构")
(setq bb6 aa6)
(foreach Block_obj Block_obj_list
(if (= (vla-get-tagstring Block_obj) New_tag1)
(vla-put-textstring Block_obj bb6)
)
)
(SETQ New_tag1 "坐落地址")
(setq bb7 aa7)
(foreach Block_obj Block_obj_list
(if (= (vla-get-tagstring Block_obj) New_tag1)
(vla-put-textstring Block_obj bb7)
)
)
(SETQ New_tag1 "备注")
(setq bb8 aa8)
(foreach Block_obj Block_obj_list
(if (= (vla-get-tagstring Block_obj) New_tag1)
(vla-put-textstring Block_obj bb8)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
)
)
这样提问
会有人来解答么
我很怀疑
页:
[1]