@pm:set-tukuang

说明:设置

用法:

 (@pm:set-tukuang)

参数:

返回值:

示例:

(defun @pm:set-tukuang ( / blkref tk-name vn0 content% corner)
  "选择一个图框，设置要处理的图框块."
  (@:help (strcat "对图框块的最低要求是，具有属性标记 图号 以及 工程名称 或 项目名称.\n"
		  "    如具有动态块的图幅特性，则会有更好的体验。"))
  (@:prompt "请点选一个图框:")
  (setq blkref (car (pickset:to-list(ssget ":E:S" '((0 . "insert")(66 . 1))))))
  (if (and blkref
	   (setq blkname (block:get-effectivename blkref))) ;; 有名      (progn
	(setq content% (@pm:get-frame-info blkref))
	;; 识别图号属性标签	(setq maybe-numbers (string:to-list (@:get-config '@pm:drawing-numbers) ","))
	(setq attdefs (block:get-attdef blkname))
	(while (and (setq attdef% (car attdefs))
		    (not (member (car attdef%) maybe-numbers))
		    (not (member (cadr attdef%) maybe-numbers))
		    )
	  (setq attdefs (cdr attdefs)))
	(if attdefs
	    (setq att-tuhao (caar attdefs))
	    (setq att-tuhao (if (setq res
				      (ui:select "请选择用于图号的属性标签名，如果没有请点取消。"
						 (mapcar 'car 
							 (block:get-attdef blkname))))
				res "")))
	(setq maybe-profession-names '("专业" "图别"))
	
	(setq attdefs (block:get-attdef blkname))
	(while (and (setq attdef% (car attdefs))
		    (not (member (car attdef%) maybe-profession-names))
		    (not (member (cadr attdef%) maybe-profession-names))
		    )
	  (setq attdefs (cdr attdefs)))
	(if attdefs
	    (setq att-profession (caar attdefs))
	    (setq att-profession (if (setq res
					   (ui:select "请选择用于专业或图别的属性标签名，如果没有请点取消。"
						      (mapcar 'car 
							      (block:get-attdef blkname))))
				     res "")))
	;; 识别项目属性标签	(if (and
	     att-tuhao
	     (or (assoc "项目名称" content%)
		 (assoc "工程名称" content%)
		 (assoc "[工程名称]" content%)
		 (assoc "子项名称" content%)))
	    (progn	
	      (@:set-config  '@pm:tukuang (block:get-effectivename blkref))
	      ;; (@:set-config  '@pm:tukuang-corner (if (assoc "可见性" content%) 0 0))	      (@:set-config '@pm:drawing-number  att-tuhao)
	      (@:set-config '@pm:profession-name att-profession)
	      (setq boxInsp (cdr (assoc "boxInsp" content%)))
	      (setq box (apply 'point:rec-2pt->4pt (entity:getbox blkref 0)))
	      (if (> (apply 'min (mapcar '(lambda(x)(distance x boxInsp)) box))
		     (* 0.001  (distance (car box)(cadr box))))
		  (@:set-config '@pm:tukuang-corner 1)
		  (@:set-config '@pm:tukuang-corner 0))
	      (@:set-config '@pm:tukuand-base
			    (cond
			      ((< (distance BoxInsp  (car box)) (distance BoxInsp  (cadr box)))
			       1)
			      (t 0)))
	      
	      (@:alert (strcat "当前工程管理的图框块名为 \n"  (block:get-effectivename blkref) " 。")))
	    (@:alert "所选图框不符合本程序运行要示。"))
	(princ))
      (progn ;; 输入图框块名	(@:alert (strcat "所选块图元不是块，或者为匿名块或无属性块，不满足本程序要求。\n"
			 "请选择图框块文件，这个文件必需是wblock导出的块定义dwg文件。"
			 ))
	(setq tk-name
	      (if (setq tk-file (getfiled "选择图框块文件""D:/Design/standard/" "dwg" 8))
		  (vl-filename-base tk-file)
		  (getstring (strcat "请输入一个图框块名称 <" (@:get-config '@pm:tukuang) ">: "))))
	(if (and (p:stringp tk-name) (/= "" tk-name))
	  (progn
	    (@:set-config '@pm:tukuang tk-name)
      	    (@:alert (strcat "当前工程管理的图框块名设置为 \n"  (@:get-config '@pm:tukuang) " 。"
			     "\n 因为是手动输入的，有可能不满足程序要求。"))
	    (princ))))
      
      ))

@lisp 函数库

介绍

调用函数

安装教程

快速上手：

@pm:set-tukuang

上传记录