ページを更新する

LISP　Example
Bricscad V19 にて確認

■境界作成コマンド(-BOUNDARY)を使って図形の輪郭を作成 2019/05/06

(defun c:rinx( / acad curdoc docs i len lenMax lst lwpObj maxExt 
				minExt mSpace newdoc objMax pt sa ss ssObj vlaObj sq sqExt)
	(setq acad (vlax-get-acad-object))
	(setq curdoc (vla-get-ActiveDocument acad))
	(setq docs (vla-get-Documents acad))
	(command "_COPYBASE" '((0 0 0)))
	(while (= (getvar "CMDNAMES") "COPYBASE")
		(command pause)
	)
	;; 新しいドキュメントを作成
	(setq newdoc (vlax-invoke-method docs 'Add))
	;; モデルスペースを取得
	(setq mSpace (vla-get-modelspace newdoc))
	;; クリップボードからペースト
	(command "_pasteclip" '((0 0 0)))
	(vla-ZoomExtents acad)
	;; 図形範囲を取得
	(setq minExt (getvar "EXTMIN") maxExt (getvar "EXTMAX"))
	(setq len (distance minExt maxExt))
	(setq lst (list
				(- (car minExt) (* len 0.1))(- (cadr minExt) (* len 0.1))
				(+ (car maxExt) (* len 0.1))(- (cadr minExt) (* len 0.1))
				(+ (car maxExt) (* len 0.1))(+ (cadr maxExt) (* len 0.1))
				(- (car minExt) (* len 0.1))(+ (cadr maxExt) (* len 0.1))
			)
	)
	;; セ―フ配列を用意
	(setq sa (vlax-make-safearray vlax-vbdouble '(0 . 7)))
	(vlax-safearray-fill sa lst)
	;; 確認する
	;;(princ "\nSA = ")(princ (vlax-safearray->list sa))
	;; LWP を作成
	(setq lwpObj (vla-AddLightWeightPolyline mSpace sa))
	;; 閉鎖する
	(vlax-put-property lwpObj 'Closed :vlax-true)
	(vla-ZoomExtents acad)
	;; 後で削除するために、選択セットに取得しておく
	(setq ss (ssget "X"))
	;; BOUNADRY の指示点
	(setq pt (list (- (car maxExt)(* len 0.05))(- (cadr maxExt) (* len 0.05))))
	;; 境界作成
	(command "-BOUNDARY" pt "")
	;; ペーストした図形と描いた四角形を削除
	(command "ERASE" ss "")
	;; -BOUNDARY で作成された四角を削除
	(setq pt (list (+ (car maxExt) (* len 0.1))(+ (cadr maxExt) (* len 0.1))))
	(if (setq ss (ssget (osnap pt "_nea")))
		(command "ERASE" ss "")
	)
	(setq ss nil)
	;; 選択セットを作成
	(setq ssObj (vla-Add (vla-get-SelectionSets newdoc) "TEMP"))
	;; すべてを選択セットに格納
	(vla-Select ssObj acSelectionSetAll)
	
	;; 長さが一番長い図形を探す
	;; 念のため面積でも比較
	(setq sqExt (* (- (car maxExt)(car minExt))(- (cadr maxExt)(cadr minExt))))
	(setq lenMax 0 objMax nil i 0)
	(repeat (vla-get-count ssObj)
		(setq vlaObj (vla-item ssObj i))
		(setq len (vlax-get-property vlaobj 'Length))
		(setq sq  (vlax-get-property vlaobj 'Area))
		(if (and (< lenMax len)(< sq sqExt))
			(setq lenMax len objMax vlaObj)
		)
		(setq i (1+ i))
	)
	;; それ以外を削除
	(if objMax
		(progn
			(setq i 0)
			(repeat (vla-get-count ssObj)
				(setq vlaObj (vla-item ssObj i))
				(if (not (equal vlaObj objMax))
					(vlax-invoke-method vlaObj 'Delete)
				)
				(setq i (1+ i))
			)
		)
	)
	;; 選択セットを削除
	(vla-Delete ssObj)
	;; 元の図面にペーストするためにクリップボードにコピー
	(command "_COPYBASE" '((0 0 0)) "ALL" "")
	;; Bricscad V19 ではフェータルエラーになるので、コメントアウト
	;;(vlax-invoke-method newdoc 'Close :vlax-false)
	;; コマンドで閉じる
	(command "CLOSE" "N")
	;; 元のドキュメントに戻っている
	;; ペースト
	(command "_pasteclip" '((0 0 0)))
	(princ)
)
(princ)

■ブロックに交差する部分をカットする線分を作成 2019/05/05
　
　２点を指示し、２点間の直下にあるブロックとの交差部分をカットした線分を作成します。

(vl-load-com)
(defun c:xx()
	;; アクティブドキュメント
	(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
	;; モデルスペース
	(setq mSpace (vla-get-ModelSpace doc))  
	
	(setq i 0 lst nil lstn nil)
	(setq p1 (getpoint "LINE の始点を指示 : "))
	(setq p2 (getpoint p1 "LINE の終点を指示 : "))

	;; LINE を作成
	(setq stVPt(vlax-3D-point p1) edVPt (vlax-3D-point p2))
	(setq vLine (vla-AddLine mSpace stVPt edVPt))
	;; フェンス選択
	(if (setq ss (ssget "F" (list p1 p2)))
		(repeat (sslength ss)
			(setq ename (ssname ss i))
			(setq vlaObj (vlax-ename->vla-object ename))
			(if (wcmatch (vlax-get-property vlaObj 'ObjectName) "*Block*")
				(progn
					(setq lst nil)
					;; 分解
					(setq vobjects (vlax-invoke-method vlaObj 'Explode))
					(setq vobjList (vlax-safearray->list (vlax-variant-value vobjects)))
					(foreach vobj vobjList
						(if (not (wcmatch (vlax-get-property vobj 'ObjectName) "*Text*,*Attribute*"))
							;; 交点リストを取得
							(if (/= (type (setq intPts (vla-IntersectWith vLine vobj acExtendNone))) vlax-vbEmpty)
								(progn
									(setq pts (vlax-safearray->list (vlax-variant-value intPts)))
									(setq j 0)
									(if pts
										(repeat (/ (length pts) 3)
											;; APPEND で LIST に追加
											;;(setq lst (append lst (list (list (nth (*  j 3) pts)(nth (+ (*  j 3) 1) pts) (nth (+ (*  j 3) 2) pts)))))
											;; CONS で LIST に追加（APPEND より速い）
											(setq lst (cons (list (nth (*  j 3) pts)(nth (+ (*  j 3) 1) pts) (nth (+ (*  j 3) 2) pts)) lst))
											(setq j (1+ j))
										)
									)
								)
							)
						)
						;; 分解した図形を削除
						(vlax-invoke-method vobj 'Delete)
					)
					(if lst
						(progn
							;; 始点から近い順にソート
							(setq lst (vl-sort lst (function (lambda (e1 e2)(< (distance p1 e1)(distance p1 e2))))))
							;; 点列の最初と最後
							(setq p1a (car lst) p2a (last lst))
							(setq lstn (cons (list p1a p2a) lstn))
						)
					)
				)
			)
			(setq i (1+ i))
		)
	)
	(if lstn
		(progn
			;; 作成した線分を削除
			(vlax-invoke-method vLine 'Delete)
			;; 始点から近い順にソート
			(setq lstn (vl-sort lstn (function (lambda (e1 e2)(< (distance p1 (car e1))(distance p1 (car e2)))))))
			(princ "\n")(princ lstn)
			(setq st p1)
			(setq i 0)
			(repeat (length lstn)
				(if (> (distance (car (nth i lstn))(cadr (nth i lstn))) 0)
					(progn
						(setq ed (car (nth i lstn)))
						(if (> (distance st ed) 0)
							(command "LINE" "non" st "non" ed "")
						)
						(setq st (cadr (nth i lstn)))
					)
				)
				(setq i (1+ i))
			)
			(if (> (distance st p2) 0)
				(command "LINE" "non" st "non" p2 "")
			)
		)
	)
	(princ)
)

■図形を囲う矩形範囲を取得 2019/05/05

　図形を選択すると、その範囲を囲う矩形が描画されます。

(vl-load-com)
(defun c:xx()
	(setq esel (entsel))
	(setq ename (car esel) pick (osnap  (cadr esel) "_nea"))
	;; near 失敗（TEXT, ATTR ...)
	(if (not pick)(setq pick (cadr esel)))
	(princ "\npick = ")(princ pick)
	
	(setq vlaObj (vlax-ename->vla-object ename))
    ;; オブジェクト名
    (setq objName (vlax-get-property vlaObj 'ObjectName))
	(princ (strcat "\nobjName = " objName))
	;; 矩形範囲を取得
	(vla-getboundingbox vlaObj 'minVpt 'maxVpt)
	;; セフティ―配列をリストに
	(setq minPt (vlax-safearray->list minVpt))
	(setq maxPt (vlax-safearray->list maxVpt))
	
	(princ "\nminPt = ")(princ minPt)
	(princ "\nmaxPt = ")(princ maxPt)
	(command "RECT" "_non" minPt "_non" maxPt)

	;; 属性を除外
	(if (= objName "AcDbBlockReference")
		;; 属性あり？
		(if (= (vla-get-HasAttributes vlaObj) :vlax-true)
			(progn
				;; ブロックをコピー
				(setq vlaObj2 (vlax-invoke-method vlaObj 'Copy))
				;; 属性を取得
				(setq lst (vlax-safearray->list (vlax-variant-value (vla-GetAttributes vlaObj2))))
				(foreach item lst
					;; 属性を空白に
					(vla-put-TextString item "")
				)
				;; 矩形範囲を取得
				(vla-getboundingbox vlaObj2 'minVpt 'maxVpt)
				;; コピーしたブロックを削除
				(vlax-invoke-method vlaObj2 'Delete)
			)
		)
	)
	(setq minPt1 (vlax-safearray->list minVpt))
	(setq maxPt1 (vlax-safearray->list maxVpt))
	;;(princ "\nminPt1 = ")(princ minPt)
	;;(princ "\nmaxPt1 = ")(princ maxPt)
	;;(command "RECT" "_non" minPt1 "_non" maxPt1)

	;; 特定の図形を除外
	(setq xLst nil yLst nil)
	(if (= objName "AcDbBlockReference")
		(progn
			(setq vlaObjects (vlax-invoke-method vlaObj 'Explode))
			;; ブロック内の図形
			(setq lst (vlax-safearray->list (vlax-variant-value vlaObjects)))
			(foreach vlaObj lst
				;; TEXT(AcDbText)、ATTR(AcDbAttributeDefinition) を除外
				(if (not (wcmatch (vlax-get-property vlaObj 'ObjectName) "*Text*,*Attribute*"))
					(progn
						;; 矩形範囲を取得
						(vla-getboundingbox vlaObj 'minVpt2 'maxVpt2)
						(setq
							minPt2 (vlax-safearray->list minVpt2)
							maxPt2 (vlax-safearray->list maxVpt2)
							;; X、Y 座標をリストに
							xLst (append xLst (list (car  minPt2) (car  maxPt2)))
							yLst (append yLst (list (cadr minPt2) (cadr maxPt2)))
						)
					)
				)
				;; 分解した図形を削除
				(vlax-invoke-method vlaObj 'Delete)
			)
			;; X、Y の最小、最大値を取得
			(setq minPt2 (list (apply 'min xLst)(apply 'min yLst) 0))
			(setq maxPt2 (list (apply 'max xLst)(apply 'max yLst) 0))
			(if (not (and (equal minPt minPt2 0.0001)(equal maxPt maxPt2 0.0001)))
				(command "RECT" "_non" minPt2 "_non" maxPt2)
			)
		)
	)
	(princ)
)

■LWPの情報取得 2019/05/01

　適当に RECTANGLE (LWPOLYLINE) を描いて、適当に FILLET しておきます。
　LISP を実行し、そのポリラインを選択すると、中心点と円弧が描画されます。

(vl-load-com)
(defun c:xx()
	(setq esel (entsel "\nLWP を選択 : "))
	(setq ename (car esel) pick (osnap (cadr esel) "_nea"))
	(princ "\npick = ")(princ pick)
	
	;; VLAオブジェクト
	(setq vlaObj (vlax-ename->vla-object ename))
	;; オブジェクト名 = "AcDbPolyline"
	(setq objName (vlax-get-property vlaObj 'ObjectName))
	(princ (strcat "\nobjName = " objName))
	;; 長さ
	(setq len (vlax-get-property vlaobj 'Length))
	(princ (strcat "\nlen = " (rtos len 2 0)))

	;; 閉鎖  :VLAX-TRUE / :VLAX-FALSE
	(setq closed (vlax-get-property vlaobj 'Closed))
	(princ "\nclosed = ")(princ closed)
	
	;; --------------------------------------
	;; 頂点の取り出し(1)
	;; --------------------------------------
	(setq coordns (vla-get-Coordinates vlaObj))
	;; 配列の取り出し
	(setq ary (vlax-variant-value coordns))
	;; 添え字の下限（通常 0）、上限を取得
	(setq l (vlax-safearray-get-l-bound ary 1)) ;; 下限
	(setq u (vlax-safearray-get-u-bound ary 1)) ;; 上限
	(princ "\nL = ")(princ l)(princ " U = ")(princ u)
	;; 頂点の数
	(setq n (fix (/ (1+ (- u l)) 2)))
	(princ "\nn = ")(princ n)
	;; 点列の取り出し
	(setq pts nil i 0)
	(repeat n
		(setq pt
			(list
				(vlax-safearray-get-element ary (* i 2))
				(vlax-safearray-get-element ary (1+ (* i 2)))
			)
		)
		(setq pts (append pts (list pt)))
		(setq i (1+ i))
	)
	(princ "\npts = ")(princ pts)
	;; --------------------------------------
	;; 頂点の取り出し(2)
	;; --------------------------------------
	(setq coordns (vla-get-Coordinates vlaObj))
	(setq lst (vlax-safearray->list (vlax-variant-value coordns)))
	(princ "\nlst = ")(princ lst)
	;; 点列の取り出し
	(setq pts nil i 0)
	(repeat (fix (/ (length lst) 2))
		(setq pt
			(list
				(nth (* i 2) lst)
				(nth (1+ (* i 2)) lst)
			)
		)
		(setq pts (append pts (list pt)))
		(setq i (1+ i))
	)
	(princ "\npts = ")(princ pts)
	
	;; 閉鎖の時は、先頭を最後に追加
	(setq n (length pts))
	(if (= closed :VLAX-TRUE)(setq pts (append pts (list (nth 0 pts)))))
	;; ふくらみの取り出し
	(setq i 0)
	(repeat n
		;; ふくらみの値が負のとき、時計廻りの方向に次の頂点がある
		;; 0 の時は直線、1 の時は半円
		(setq bulge (vla-GetBulge vlaObj i))
		(princ (strcat "\nbluge" (itoa i) " = " (rtos bulge 2 4)))
		;; 次の頂点との間の円弧の中心角の 1/4 の正接(TANGENT)
		(setq ang (* (atan bulge) 4) deg (/ (* ang 180) PI))
		(princ " deg = ")(princ deg)
		(if (/= ang 0)
			(progn
				(setq p1 (nth i pts) p2 (nth (1+ i) pts))
				;; 円弧の始点－終点間の距離の1/2を求める
				(setq d (/ (distance p1 p2) 2))
				;; 円弧の半径
				(setq h (/ d (sin (/ ang 2))))
				(setq r (abs h))
				(princ " r = ")(princ (rtos r))
				;; 円弧の中心
				(setq cen (polar (nth i pts) (+ (/ (- PI ang) 2) (angle p1 p2)) h)) 
				;; 中心の確認
				(command "CIRCLE" cen 1)
;				(if (> bulge 0)
;					(command "ARC" "C" cen p1 p2)
;					(command "ARC" "C" cen p2 p1)
;				)
				;; 開始-終了角度
				(if (> bulge 0)
					(setq stang (angle cen p1) edang (angle cen p2))
					(setq stang (angle cen p2) edang (angle cen p1))
				)
				;; 開始角度の確認
				(command "ARC" "C" cen (polar cen stang r)(polar cen edang r))
			)
		)
		(setq i (1+ i))
	)
	(princ)
)