Statistics: Posted by pmeadow01 — Thu Mar 28, 2024 11:34 am
Code:
(defun LO-changed (LO-data LO-callback / ) (alert (strcat "Layout Switched to " (getvar "ctab") ".")) (pn "LO-data") (pn "LO-callback") (SV-changed T '("CANNOSCALE" T)) )
Statistics: Posted by QuanNguyen — Thu Mar 28, 2024 2:59 am
Statistics: Posted by pmeadow01 — Wed Mar 27, 2024 1:05 pm
Statistics: Posted by QuanNguyen — Tue Mar 12, 2024 8:28 pm
Statistics: Posted by Precious — Wed Mar 06, 2024 3:36 am
Statistics: Posted by Xabriña — Mon Mar 04, 2024 5:15 am
Code:
(defun c:tabord2(/ aCen cAng cCen cPl cRad cRegfDr it lCnt lLst mSp pCen pT1pT2 ptLst R tHt tLst vlaPl vlaTab ptLstvLst cTxt oldCol nPl clFlg actDoctPt1 tPt2 cAng tiPt oSnp *error*) (vl-load-com) (defun Extract_DXF_Values(Ent Code) (mapcar 'cdr (vl-remove-if-not '(lambda(a)(=(car a)Code)) (entget Ent))) ); end of (defun Add_Text(pt size val) (entmake (list '(0 . "TEXT") (cons 10 pt)(cons 40 size) (cons 1 val) (cons 7 (getvar "TEXTSTYLE")) '(71 . 0) '(72 . 1) '(73 . 1) (cons 11 pt)))) (defun *error*(msg) (setvar "CMDECHO" 1) (if oSnp(setvar "OSMODE" oSnp)) (if mSp(vla-EndUndoMark actDoc)) (princ) ); end of *error* (if (and (setq cPl(entsel "\nSelect LwPoliline > ")) (= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0))) ); end and(progn (princ "\nPlease Wait... \n") (setq vlaPl(vlax-ename->vla-object(car cPl));;;ptLst(mapcar 'append;;; (setq vLst(Extract_DXF_Values(car cPl)10));;; (mapcar 'list(Extract_DXF_Values(car cPl)42)))r 2 lCnt 0tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius"))actDoc(vla-get-ActiveDocument (vlax-get-acad-object))mSp(vla-get-ModelSpace actDoc)tHt(getvar "TEXTSIZE") ); end setq (setq i 0 ptLst (list) vLst (list)) (while (< i (vlax-curve-getEndParam vlaPl)) (setq pt (vlax-curve-GetPointAtParam vlaPl i) bulge (vla-GetBulge vlaPl i)row (list (car pt) (cadr pt) bulge)vLst (append vLst (list (list (car pt) (cadr pt))))ptLst (append ptLst (list row))i(1+ i)) ) (if (=(vla-Get-Closed vlaPl) :vlax-false) (setq pt (vlax-curve-GetendPoint vlaPl)row (list (car pt) (cadr pt) 0)vLst (append vLst (list (list (car pt) (cadr pt))))ptLst (append ptLst (list row)))) (vla-StartUndoMark actDoc) (setvar "CMDECHO" 0) (setq oSnp(getvar "OSMODE")) (foreach vert ptLst (setq vert(trans vert 0 1) tLst(append tLst (list(list r 0(itoa(1+ lCnt))) (list r 1(rtos(car vert)2 4)) (list r 2(rtos(cadr vert)2 4)) (list r 3 "")))) (if(and (/= 0.0(last vert)) (setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt)) (setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt))) ); end and(setq r(1+ r) cRad(abs(/(distance pt1 pt2) 2(sin(/(* 4(atan(abs(last vert))))2)))) aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt)) fDr(vlax-curve-getFirstDeriv vlaPl (vlax-curve-getParamAtPoint vlaPl aCen)) pCen(trans (polar aCen(-(if(minusp(last vert)) pi(* 2 pi)) (atan(/(car fDr)(cadr fDr))))cRad)0 1) tLst(append tLst(list (list r 0 "center") (list r 1(rtos(car pCen)2 4)) (list r 2(rtos(cadr pCen)2 4)) (list r 3(rtos cRad 2 4)))) ); end setq); end if (setq r(1+ r) lCnt(1+ lCnt)) ); end foreach (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))(+ 1(/(length tLst)4)) 4 (* 3 tHt)(* 20 tHt))) (foreach i tLst (vl-catch-all-apply 'vla-SetText(cons vlaTab i)) ;(vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt) ;(vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter) ); end foreach;;; (vla-put-VertCellMargin vlaTab (* 0.75 tHt));;; (vla-put-Height vlaTab(* 1.75(/(length tLst)4)));;; (vla-SetColumnWidth vlaTab 0 (* 10 tHt));;; (vla-SetColumnWidth vlaTab 3 (* 12 tHt));;; (vla-put-RepeatTopLabels vlaTab :vlax-true);;; (vla-put-BreakSpacing vlaTab (* 3 tHt));;; (vla-DeleteRows vlaTab 0 1) (princ "\n<<< Place Table >>> ") (command "_.copybase" (trans '(0 0 0)0 1)(entlast) "") (command "_.erase" (entlast) "") (command "_.pasteclip" pause) (if(= :vlax-true(vla-get-Closed vlaPl)) (progn (setq nPl(vla-Copy vlaPl)) (command "_.region" (entlast) "") (setq cCen(vlax-get(setq cReg (vlax-ename->vla-object(entlast)))'Centroid)) (vla-Delete cReg) (setq clFlg T) ); end progn ); end if (setq lCnt 0) (setvar "OSMODE" 0) (setq oldCol(getvar "CECOLOR")) (foreach v vLst (if clFlg (setq cAng(angle cCen(trans v 0 1)) iPt(polar v cAng (* 2 tHt))) (setq tPt1(vlax-curve-GetPointAtParam vlaPl (- lCnt 0.0000001)) tPt2(vlax-curve-GetPointAtParam vlaPl (+ lCnt 0.0000001)) iPt(polar v(+(* pi 0.5)(if(minusp(setq cAng(angle tPt1(if tPt2 tPt2 (polar tPt1(* 0.5 pi)0.0000001)))))cAng(- cAng)))(* 2 tHt)) ); end setq ); end if (Add_Text (list (car ipt) (cadr ipt) 0) tHt (itoa(1+ lCnt))) (setq lCnt(1+ lCnt) ); end setq (setvar "CECOLOR" "1") ;(command "_.circle" v (/ tHt 3)) (entmake (list (cons 0 "CIRCLE") (cons 10 (list (car v) (cadr v) 0)) (cons 40 (/ tHt 3)))) (setvar "CECOLOR" oldCol) ); end foreach (setvar "OSMODE" oSnp) (setvar "CMDECHO" 1) (vla-EndUndoMark actDoc) ); end progn (princ "\n<!> It isn't LwPolyline! Quit. <!> ") ); end if (gc) (princ) ); end of c:tabord2
Statistics: Posted by QuanNguyen — Mon Mar 04, 2024 1:51 am
Code:
(defun c:tabord2(/ aCen cAng cCen cPl cRad cRegfDr it lCnt lLst mSp pCen pT1pT2 ptLst R tHt tLst vlaPl vlaTabvLst cTxt oldCol nPl clFlg actDoctPt1 tPt2 cAng tiPt oSnp *error*) (vl-load-com) (defun Extract_DXF_Values(Ent Code) (mapcar 'cdr (vl-remove-if-not '(lambda(a)(=(car a)Code)) (entget Ent))) ); end of (defun *error*(msg) (setvar "CMDECHO" 1) (if oSnp(setvar "OSMODE" oSnp)) (if mSp(vla-EndUndoMark actDoc)) (princ) ); end of *error* (if (and (setq cPl(entsel "\nSelect LwPoliline > ")) (= "LWPOLYLINE"(car(Extract_DXF_Values(car cPl)0))) ); end and(progn (princ "\nPlease Wait... \n") (setq vlaPl(vlax-ename->vla-object(car cPl))ptLst(mapcar 'append (setq vLst(Extract_DXF_Values(car cPl)10)) (mapcar 'list(Extract_DXF_Values(car cPl)42)))r 2 lCnt 0tLst '((1 0 "Point")(1 1 "X")(1 2 "Y")(1 3 "Radius"))actDoc(vla-get-ActiveDocument (vlax-get-acad-object))mSp(vla-get-ModelSpace actDoc)tHt(getvar "TEXTSIZE") ); end setq (vla-StartUndoMark actDoc) (setvar "CMDECHO" 0) (setq oSnp(getvar "OSMODE")) (foreach vert ptLst (setq vert(trans vert 0 1) tLst(append tLst (list(list r 0(itoa(1+ lCnt))) (list r 1(rtos(car vert)2 4)) (list r 2(rtos(cadr vert)2 4)) (list r 3 "")))) (if(and (/= 0.0(last vert)) (setq pt1(vlax-curve-GetPointAtParam vlaPl lCnt)) (setq pt2(vlax-curve-GetPointAtParam vlaPl(1+ lCnt))) ); end and(setq r(1+ r) cRad(abs(/(distance pt1 pt2) 2(sin(/(* 4(atan(abs(last vert))))2)))) aCen(vlax-curve-GetPointAtParam vlaPl(+ 0.5 lCnt)) fDr(vlax-curve-getFirstDeriv vlaPl (vlax-curve-getParamAtPoint vlaPl aCen)) pCen(trans (polar aCen(-(if(minusp(last vert)) pi(* 2 pi)) (atan(/(car fDr)(cadr fDr))))cRad)0 1) tLst(append tLst(list (list r 0 "center") (list r 1(rtos(car pCen)2 4)) (list r 2(rtos(cadr pCen)2 4)) (list r 3(rtos cRad 2 4)))) ); end setq); end if (setq r(1+ r) lCnt(1+ lCnt)) ); end foreach (setq vlaTab(vla-AddTable mSp (vlax-3D-point '(0 0 0))(+ 1(/(length tLst)4)) 4 (* 3 tHt)(* 20 tHt))) (foreach i tLst (vl-catch-all-apply 'vla-SetText(cons vlaTab i)) (vla-SetCellTextHeight vlaTab(car i)(cadr i)tHt) (vla-SetCellAlignment vlaTab(car i)(cadr i)acMiddleCenter) ); end foreach (vla-put-VertCellMargin vlaTab (* 0.75 tHt)) (vla-put-Height vlaTab(* 1.75(/(length tLst)4))) (vla-SetColumnWidth vlaTab 0 (* 10 tHt)) (vla-SetColumnWidth vlaTab 3 (* 12 tHt)) (vla-put-RepeatTopLabels vlaTab :vlax-true) (vla-put-BreakSpacing vlaTab (* 3 tHt)) (vla-DeleteRows vlaTab 0 1) (princ "\n<<< Place Table >>> ") (command "_.copybase" (trans '(0 0 0)0 1)(entlast) "") (command "_.erase" (entlast) "") (command "_.pasteclip" pause) (if(= :vlax-true(vla-get-Closed vlaPl)) (progn (setq nPl(vla-Copy vlaPl)) (command "_.region" (entlast) "") (setq cCen(vlax-get(setq cReg (vlax-ename->vla-object(entlast)))'Centroid)) (vla-Delete cReg) (setq clFlg T) ); end progn ); end if (setq lCnt 0) (foreach v vLst (if clFlg (setq cAng(angle cCen(trans v 0 1)) iPt(polar v cAng (* 2 tHt))) (setq tPt1(vlax-curve-GetPointAtParam vlaPl (- lCnt 0.0000001)) tPt2(vlax-curve-GetPointAtParam vlaPl (+ lCnt 0.0000001)) iPt(polar v(+(* pi 0.5)(if(minusp(setq cAng(angle tPt1(if tPt2 tPt2 (polar tPt1(* 0.5 pi)0.0000001)))))cAng(- cAng)))(* 2 tHt)) ); end setq ); end if (setvar "OSMODE" 0) (setq cTxt(vla-AddText mSp(itoa(1+ lCnt)) (vlax-3d-point iPt) tHt) tiPt(vla-get-InsertionPoint cTxt) lCnt(1+ lCnt) ); end setq (vla-put-Alignment cTxt 10) (vla-put-TextAlignmentPoint cTxt tiPt) (setq oldCol(getvar "CECOLOR")) (setvar "CECOLOR" "1") (command "_.circle" v (/ tHt 3)) (setvar "CECOLOR" oldCol) ); end foreach (setvar "OSMODE" oSnp) (setvar "CMDECHO" 1) (vla-EndUndoMark actDoc) ); end progn (princ "\n<!> It isn't LwPolyline! Quit. <!> ") ); end if (gc) (princ) ); end of c:tabord2
Statistics: Posted by Xabriña — Fri Mar 01, 2024 3:08 pm
Statistics: Posted by sln8458 — Sun Jan 14, 2024 3:27 am
Statistics: Posted by QuanNguyen — Sat Jan 13, 2024 6:52 pm
Code:
; Create Insulation Layer + layer attributes(defun MKLAY_INS () (princ "\n start MKLAY_INS ");(if (tblsearch "layer" "Insulation")(CD_SHAPE)(progn(regapp "accmtransparency")(entmakex (list(cons 0 "LAYER");defines create new layer(cons 100 "AcDbSymbolTableRecord")(cons 100 "AcDbLayerTableRecord")(cons 2 "Insulation"); Layer name;(cons 6 "Continuous") ; linetype; (cons 370 LWeight) ; lineWeight(cons 62 2) ; Layer color; (cons 70 0) ; on, unlocked, thawed;(cons 290 1) ; Plot/No Plot : 0->No plot;(cons 440 "65") ; Layer Transparency(cons -3 ; transparency(list(list "accmtransparency"; transparency(cons 1071 (LM:trans->dxf 65))) ) ); transparency);end list);end entmake);end progn); end If (CD_SHAPE)) ;end MKLAY_INS
Code:
;Check if layer 'insulation' exists(defun CK_LAY ()(if (tblsearch "layer" "Insulation")(CD_SHAPE)(MKLAY_INS)):END IF);END CK_LAY
Statistics: Posted by sln8458 — Fri Jan 12, 2024 3:21 am
Code:
((/= eit 0)
Code:
((/= eit "0")
Statistics: Posted by sln8458 — Tue Jan 09, 2024 8:59 am
Statistics: Posted by sln8458 — Tue Jan 09, 2024 4:12 am
Statistics: Posted by sln8458 — Tue Jan 09, 2024 3:22 am