Leaderboard

Not an answer to your question, but correction (remark)... ... (setq kk -1) (setq tot 0.0) (repeat ... ...

I'm afraid, you would put in an area that is too large, large area for expansion (case two adjacent angles: α + β > pi), or trim area (case two adjacent angles: α + β < pi). So, I added a warning. I have fixed this lisp. Extend_Trim_Area(DHT).lsp

$0.02 if both sides parallel 90d, manually calculation, Area= Width x Height, where A = W x H, eg: required A= 20M ,known Height=4, ie: offset, W=A/H = 20/4 = 5.00 either offset or move along axis ortho ... (defun c:tt ( / ) (initget 7) (and (setq a (getreal "\nEnter Area ")) ; input area (setq s (ssget "_:S:E+." '((0 . "LWPOLYLINE,LINE")))) ; pick line single selection (setq en (ssname s 0)) (setq p (getpoint "\npick side.. ")) ; pick offset side (if (< (setq ep (vlax-curve-getEndParam en)) 2) ; check whether only 2 points (progn (vl-cmdf "_OFFSET" ; offset the line (/ a (vlax-curve-getDistAtParam en ep)) ; calculate X , A divided Y en p "" ) (princ "\nDone.") ) (princ "\nSingle line!!") ) ) (princ) ) another 2 different scenarios which open & close polyline

Did you run ATTSYNC on the block after you changed the attribute? If not, the attributes in the existing instances will keep their old properties, including layer.

Idk if it will solve your problem but... (defun c:hat ( / ss) (if (setq ss (ssget '((0 . "HATCH")))) (alert (strcat "Total Area: " (rtos (apply '+ (mapcar 'vla-get-Area (JH:selset-to-list-vla ss))) 2 3))) ) ) (defun JH:selset-to-list-vla (selset / lst i) ; Returns all entities within a selection set into a list of vla-objects. (repeat (setq i (sslength selset)) (setq lst (cons (vlax-ename->vla-object (ssname selset (setq i (1- i)))) lst)) ) (reverse lst) )

I know, but 2, "str" and any real numbers are not lists and so are evaluated.

Makes sense now, although (eq 2 2) or (eq "str" "str") returns T. Oh, please don't make me any dizzier than I already am

Ignore my code above, below is a more robust approach: (defun c:Test ( / *error* insidepoly RemoveAdjacentDuplicates ent maxpt minpt osm pt ss txt) ; Variable modified by Jonathan Handojo ;; Tharwat - Date: 06.Jun.2017 ;; (defun *error* (msg) (setvar "OSMODE" osm) (princ (strcat "Error: " msg))) ; Added by Jonathan Handojo (defun insidepoly (pt ent ray / ints) (setq ints (vlax-invoke (vlax-ename->vla-object ent) 'intersectwith ray acExtendNone)) (if (eq (rem (length ints) 6) 3) ent) ) (defun RemoveAdjacentDuplicates (lst / tst) ; Function Added by Jonathan Handojo (setq tst lst) (vl-remove nil (mapcar '(lambda (x) (if (null (equal x (car (setq tst (cdr tst))) 1e-8)) x)) lst)) ) ;; Snap adjusted by Jonathan Handojo (setq osm (getvar "OSMODE")) (setvar "OSMODE" 0) (if (and (setq pt (getpoint "\nPick a point :")) (setq ss (ssget "_X" '((0 . "*POLYLINE") (8 . "testA")))) (setq ray (vla-AddRay (vla-get-ModelSpace (vla-get-ActiveDocument (vlax-get-acad-object))) (vlax-3d-point pt) (vlax-3d-point (polar pt 0 1)))) (setq ent (vl-some '(lambda (x) (insidepoly pt x ray)) (JH:selset-to-list ss))) ; Modified by Jonathan Handojo ) (progn (vla-ZoomWindow (vlax-get-acad-object) (progn (vla-GetBoundingBox (vlax-ename->vla-object ent) 'minpt 'maxpt) minpt ) maxpt ) (setq txt (ssget "_WP" (RemoveAdjacentDuplicates (mapcar 'cdr (vl-remove-if-not '(lambda (x) (eq (car x) 10)) (entget ent))) ) '((0 . "TEXT,MTEXT")) ) txt (if txt (cdr (assoc 1 (entget (ssname txt 0))))) ) (vla-ZoomPrevious (vlax-get-acad-object)) ) ;; Below is modification added ) (vla-Delete ray) (setvar "OSMODE" osm) (if txt (princ (strcat "\n" txt))) (princ) ) (defun JH:selset-to-list (selset / lst iter) ; Returns all entities within a selection set into a list. (setq iter 0) (repeat (sslength selset) (setq lst (cons (ssname selset iter) lst) iter (1+ iter)) ) (reverse lst) ) In my case, it prints the text to the command line

another offset concept 2 options ;; Offset segment for polyline (defun c:OFFSEG ( / *error* $ aa aa* _angle ang ax en ep force_closed i ip k l l1 lst n p p1 px s sc sp vs ) ;;hanhphuc 01.04.2020 ;*offseg_area* - global variable (setq force_closed 1 ;; setting closed=1 , open=0 *error* '((msg) (princ " *cancel*")) _angle '((en x) (angle '(0. 0. 0.) (vlax-curve-getFirstDeriv en x))) ) (while (setq s (ssget "_:S:E:L+." '((0 . "LWPOLYLINE")))) (and (setq en (ssname s 0) p1 (osnap (cadr (grread t 13)) "_nea")) (not (vla-put-closed (vlax-ename->vla-object en) force_closed )) (setq p (trans p1 1 0) i (fix (vlax-curve-getparamatpoint en p)) ep (vlax-curve-getEndParam en)) (>= ep 2) (setq ang (mapcar '(lambda (x) (_angle en x) ) (cond ( (< i 1)(list (1- ep) (1+ i)) ) ( (>= i (1- ep)) (list (1- i) 0)) ( (list (1- i) (1+ i)) ) ) ) ) (setq *offseg_area* (ureal 5 "" "\nEnter area " (cond ( *offseg_area* ) ( 0.000 ) ) ) ) (princ "\nStretching segment.. \n") (while (and p (mapcar 'set '(k p) (grread t 13)) (= 5 k) (vl-consp p) (setq p1 (trans p 1 0)) ) (redraw) (if (vl-some 'not (setq l (mapcar '(lambda (a b / p) (list (setq p (vlax-curve-getPointAtParam en b)) (inters p (polar p a 1.0) p1 (polar p1 (_angle en i) 1.0 ) nil ) ) ) ang (list i (1+ i)) ) l1 (apply 'append l) n (length l1) lst (mapcar '(lambda (x) (nth x l1)) '(0 1 3 2)) ) ) (setq p nil) (if (= *offseg_area* 0.0) (progn (grvecs (apply 'append (mapcar '(lambda (x) (cons (car x) (mapcar '(lambda (x) (trans x 0 1) ) (cdr x) ) ) ) (cons (cons 2 (mapcar 'cadr l)) (mapcar '(lambda (x) (cons 2 x)) l ) ) ) ) ) (princ (apply 'strcat (setq $ (list "\rArea = " (rtos (setq AA* (abs (math:area lst))) 2 2 ) " M\U+00B2 " ) ) ) ) ) (princ (strcat "\rSelect offset side.. ")) ) ) ); while (if (and (/= *offseg_area* 0.00) (setq ip (apply 'inters (apply 'append (reverse (cons '(nil) l))) ) ) (setq AA (abs (math:area (list (car l1) ip (caddr l1))) ) ) (setq Ax ((if (minusp (- AA (abs (math:area (list (cadr l1) ip (cadddr l1)))) ) ) + - ) AA *offseg_area* ) sc (sqrt (/ (abs Ax) AA)) lst (cons (car l1) (append (mapcar '(lambda (x) (polar ip (angle ip (x l1)) (* (distance ip (x l1)) sc ) ) ) (list car caddr) ) (list (caddr l1)) ) ) AA* (abs (math:area lst)) $ (list "\rArea = " (rtos AA* 2 2) " M\U+00B2 " ) ) (equal AA* *offseg_area* 1e-6) ) ;and (princ (apply 'strcat $ ) ) (progn (setq sp (mapcar '(lambda (x) (vlax-curve-getPointAtParam en x) ) (list i (1+ i)) ) px (mapcar '(lambda (` p a) (polar p a (` (/ *offseg_area* (abs (* (sin (- (cadr ang) (_angle en i))) (apply 'distance sp) ) ) ) ) ) ) (if (LM:Inside-p p en ) ;;; UCS some not working (list - +) (list + -)) sp ang ) ) (setq lst (if (= *offseg_area* 0.0) lst (list (car sp) (car px) (cadr px) (cadr sp) ) ) AA* (abs (math:area lst)) $ (list "\rArea = " (rtos AA* 2 2) " M\U+00B2 " ) ) ) ) ;if (if (or (equal AA* *offseg_area* 1e-6) (= *offseg_area* 0.0) ) (entmakex (vl-list* '(0 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(70 . 0) (cons 90 (length lst)) (mapcar '(lambda (x) (cons 10 x)) lst) ) ) (if (not (= *offseg_area* 0)) (alert (strcat "Exceed chamfer limit!\nMax = " (if ip (rtos AA 2 2) "???") "\ M\U+00B2" ) ) ) ) ) ) (princ) ) ;This function is freeware courtesy of the author's of "Inside AutoLisp" for rel. 10 ;published by New Riders Publications. ;This credit must accompany all copies of this function. ;;;October 19, 2004 added function chkkwds (see description at end of file) ;* UREAL User interface real function ;* BIT (0 for none) and KWD key word ("" for none) are same as for INITGET. ;* MSG is the prompt string, to which a default real is added as <DEF> (nil ;* for none), and a : is added. ;* (defun ureal (bit kwd msg def / inp) (if def (setq msg (strcat "\n" msg " <" (if (eq (type def) 'REAL) (rtos def 2) (if (eq (type def) 'INT) (itoa def) def ) ) ">: " ) bit (* 2 (fix (/ bit 2))) ) (setq msg (strcat "\n" msg ": ")) ) (initget bit kwd) (setq inp (getreal msg)) (if inp inp def ) ) ;;----------------------=={ Inside-p }==----------------------;; ;; ;; ;; Predicate function to determine whether a point lies ;; ;; inside a supplied LWPolyline. ;; ;;------------------------------------------------------------;; ;; Author: Lee Mac - www.lee-mac.com ;; ;; Using some code by gile (as marked below), thanks gile. ;; ;;------------------------------------------------------------;; ;; Arguments: ;; ;; pt - 3D WCS point to test ;; ;; ent - LWPolyline Entity against which to test point ;; ;;------------------------------------------------------------;; ;; Returns: T if supplied point lies inside supplied LWPoly ;; ;;------------------------------------------------------------;; (defun LM:Inside-p ( pt ent / _GroupByNum lst nrm obj tmp ) (defun _GroupByNum ( l n / r) (if l (cons (reverse (repeat n (setq r (cons (car l) r) l (cdr l)) r)) (_GroupByNum l n) ) ) ) (if (= (type ent) 'VLA-OBJECT) (setq obj ent ent (vlax-vla-object->ename ent)) (setq obj (vlax-ename->vla-object ent)) ) (setq lst (_GroupByNum (vlax-invoke (setq tmp (vlax-ename->vla-object (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 pt) (cons 11 (trans '(1. 0. 0.) ent 0)) ) ) ) ) 'IntersectWith obj acextendnone ) 3 ) ) (vla-delete tmp) (setq nrm (cdr (assoc 210 (entget ent)))) ;; gile: (and lst (not (vlax-curve-getparamatpoint ent pt)) (= 1 (rem (length (vl-remove-if (function (lambda ( p / pa p- p+ p0 s1 s2 ) (setq pa (vlax-curve-getparamatpoint ent p)) (or (and (equal (fix (+ pa (if (minusp pa) -0.5 0.5))) pa 1e-7) (setq p- (cond ( (setq p- (vlax-curve-getPointatParam ent (- pa 1e-7))) (trans p- 0 nrm) ) ( (trans (vlax-curve-getPointatParam ent (- (vlax-curve-getEndParam ent) 1e-7)) 0 nrm) ) ) ) (setq p+ (cond ( (setq p+ (vlax-curve-getPointatParam ent (+ pa 1e-7))) (trans p+ 0 nrm) ) ( (trans (vlax-curve-getPointatParam ent (+ (vlax-curve-getStartParam ent) 1e-7)) 0 nrm) ) ) ) (setq p0 (trans pt 0 nrm)) (<= 0 (* (sin (angle p0 p-)) (sin (angle p0 p+)))) ;; LM Mod ) (and (/= 0. (vla-getBulge obj (fix pa))) (equal '(0. 0.) (cdr (trans (vlax-curve-getFirstDeriv ent pa) 0 nrm)) 1e-9) ) ) ) ) lst ) ) 2 ) ) ) ) ;math formula ; | x1 x2 x3 x4 xn.. | ; 1 | \/ \/ \/ \/ | ;Area= / | /\ /\ /\ /\ | ; 2 | y1 y2 y3 y4 yn.. | ; (defun math:area (l) ;hanhphuc (* (apply '- (mapcar '(lambda (x y) (apply '+ (mapcar '* (mapcar x l) (mapcar y (append (cdr l) (list (car l))))) ) ) '(car cadr) '(cadr car) ) ) 0.5 ) ) 1. if user input any value <> 0 the routine emulates just like OFFSET command does, just move the mouse which side to offset saving typing -ve 2. if user input zero, i.e= 0, activate dynamic mode like my previous post which has no restriction, free style parallel solution, W=A/H offset solution, scale A'=A x S² checking bug... 1.not for lines, convert+join+ purge vertices 2.single line N/A 3.not support bulged polyline or 3dpoly

Find the line below in previous code: (repeat (length dets) And replace that line with: (repeat (length (setq dets (vl-sort dets '(lambda (x y) (< (car x) (car y))))))

I guess you can just set the header and title style straight from the Table Style Manager to 250. Or do as BIGAL says within the code, but result will be different if you change the style to something else and then reverting it back. For BIGAL's approach on my code, under this line (vl-catch-all-apply 'vla-put-StyleName (list vtab desired)) [or you can even replace it actually], put: (vla-SetTextHeight vtab (+ acDataRow acHeaderRow acTitleRow) 250)

Try (vla-SetTextHeight tableobj (+ acDataRow acHeaderRow acTitleRow) txtht) you are setting colwidth etc so make a guess. My need also (VLA-SETCELLTEXTHEIGHT tableobj rownum k txtht) I have problems changing an unknown style so have to hit it with big hammer.

Worked for me but very much hatch pattern dependant some worked others did not. tile pattern ok *HT600x3003ET,600x300mm 3mm Free patterns from www.AUTOCADhatch.com 0,3,0, 0,603, 300,-3.0 0,3,3, 0,603, 300,-3.0 90,3,3, 0,303, 600,-3.0 90,0,3, 0,303, 600,-3.0

@xpr0, Lisp here: (defun DXF (code en) (cdr (assoc code (entget en)))) ;;;========================================================================= (defun Line (p1 p2) (entmakex (list (cons 0 "LINE") (cons 10 p1) (cons 11 p2)))) (defun Ray (po V) (entmakex (list (cons 0 "RAY") (cons 100 "AcDbEntity") (cons 100 "AcDbRay") (cons 10 po) (cons 11 v) ) ) ) ;;;========================================================================= (defun sysvar-set (lst_setvar / strN var var_oldname n) (setq n 0 lstvar_thiep nil lstValue_thiep nil ) (repeat (/ (length lst_setvar) 2) (setq var (nth n lst_setvar) var_oldname (strcat "oldvar_thiep" (itoa n)) ) (setq lstvar_thiep (append lstvar_thiep (list var))) (set (read var_oldname) (getvar var)) (setq lstValue_thiep (append lstValue_thiep (list (read var_oldname)))) (setvar var (nth (+ n 1) lst_setvar)) (setq n (+ 2 n)) ) ) (defun Get-Area (lst ) (/ (apply '+ (mapcar '(lambda (a b) (- (* (car b) (cadr a)) (* (car a) (cadr b)))) lst (cons (last lst) lst) ) ) 2 ) ) ;;;========================================================================= (defun SYSVAR-RESTORE () (mapcar '(lambda (var value) (setvar var (eval value))) lstvar_thiep lstValue_thiep ) ) ;;;========================================================================= (defun CalcZ (Pt1 Pt2 Pt3 / v w) (setq v (mapcar '- Pt1 Pt2) w (mapcar '- Pt3 Pt2) ) (- (* (car v) (cadr w)) (* (cadr v) (car w))) ) ;;========================================================================= (defun calcThiep (po1 po2 po3 po4 / bit dis m anpha beta h obj_top poS poE) (setq anpha_org (LM:GetInsideAngle po4 po1 po2) beta_org (LM:GetInsideAngle po1 po2 po3) ) (if (< dt 0) (setq anpha anpha_org beta beta_org ) (setq anpha (- pi anpha_org) beta (- pi beta_org) ) ) (Setq bit (CalcZ po1 po4 po2)) (setq dis (distance po1 po2) ang (angle po1 po2) ) (cond ((not (equal (+ anpha_org beta_org) pi 1e-6)) (setq m (+ (/ (cos anpha) (sin anpha)) (/ (cos beta) (sin beta)))) (setq h (abs (/ (- dis (sqrt (abs (- (* dis dis) (* 2 m (abs dt)))))) m)) ) (cond ((or (and (> bit 0) (> dt 0)) (and (< bit 0) (< dt 0))) (setq po5 (polar po2 (- ang (/ pi 2)) h) po6 (polar po1 (- ang (/ pi 2)) h) ) ) ((or (and (> bit 0) (< dt 0)) (and (< bit 0) (> dt 0))) (setq po5 (polar po2 (+ ang (/ pi 2)) h) po6 (polar po1 (+ ang (/ pi 2)) h) ) ) ) ) ((equal (+ anpha_org beta_org) pi 1e-6) (setq h (/ dt dis)) (cond ((or (and (< bit 0) (< dt 0)) (and (< bit 0) (> dt 0))) (setq po5 (polar po2 (+ ang (/ pi 2)) h) po6 (polar po1 (+ ang (/ pi 2)) h) ) ) ((or (and (> bit 0) (> dt 0)) (and (> bit 0) (< dt 0))) (setq po5 (polar po2 (- ang (/ pi 2)) h) po6 (polar po1 (- ang (/ pi 2)) h) ) ) ) ) ) (setq po_in1 (inters po5 po6 po1 po4 nil) po_in2 (inters po5 po6 po2 po3 nil) ) ) (defun makeLWPoly (lst) (entmakex (append (list (cons 0 "LWPOLYLINE") (cons 100 "AcDbEntity") (cons 100 "AcDbPolyline") (cons 90 (length lst)) ) (mapcar (function (lambda (p) (cons 10 p))) lst) ) ) ) (defun limS (po1 po2 po3 po4 / objL1 objL2 objR iplist) (line po4 po1) (setq objL1 (vlax-ename->vla-object (entlast))) (line po3 po2) (setq objL2 (vlax-ename->vla-object (entlast))) (cond ((> dt 0) (setq iplist (vlax-invoke objL1 'IntersectWith objL2 acExtendBoth) ) (vla-delete objL1) (vla-delete objL2) (if iplist (SETQ A (Get-Area (list po1 po2 iplist po1)))) ) ((< dt 0) (ray po4 (mapcar '- po2 po1)) (setq objR (vlax-ename->vla-object (entlast))) (if (null (vlax-invoke objR 'IntersectWith objL2 acExtendNone)) (PROGN (setq iplist (vlax-invoke objR 'IntersectWith objL2 acExtendOtherEntity ) ) (SETQ A (Get-Area (list po1 po2 iplist po4 po1))) ) (PROGN (vla-delete objR) (ray po3 (mapcar '- po1 po2)) (setq objR (vlax-ename->vla-object (entlast))) (setq iplist (vlax-invoke objR 'IntersectWith objL1 acExtendOtherEntity ) ) (if iplist (SETQ A (Get-Area (list po1 po2 po3 iplist po1)))) ) ) (vla-delete objL1) (vla-delete objL2) (vla-delete objR) ) ) (if A (abs A)) ) ;;;========================================================================= (defun c:dht (/ ent1_lst ent1 ent2 ent3 po1 po2 po3 po4 ang1 ang2 ang3 dis m lstpo1 lstpo2 lstpo3 lstpo-int1 lstpo-int2 anpha beta pS1 pS2 pS3 pE1 pE2 pE3 h bit obj_top poS poE po_in1 po_in2 prom Alim ) (command "undo" "be") (sysvar-set '("cmdecho" 0 "osmode" 0)) (defun *error* (msg) (or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*") (princ (strcat "\n** Error: " msg " **")) ) (setq dt nil) (sysvar-restore) (command "undo" "en") (princ) ) (or dt (setq dt (getcfg "AppData/trapezoid/area")) (setq dt 1000)) (setq prom (acet-str-format "\nEnter Area given for to expand (+S) or to trim (-S) <%1> : " (if (numberp dt) (rtos dt 2 3) dt ) ) ) (setq olddt dt) (setq dt (getreal prom)) (if (null dt) (setq dt olddt) ) (if (not (numberp dt)) (setq dt (atof dt)) ) (while (OR (NOT (setq ent1_lst (entsel "\nPick a LINE (or LWPOLYLINE) edge for to expand (or to trim) area " ) ) ) (NOT (wcmatch (DXF 0 (setq ent1 (car ent1_lst))) "LINE,LWPOLYLINE")) ) (prompt "\nPick a LINE is not right, Please pick again") ) (cond ((eq (DXF 0 ent1) "LINE") (while (OR (NOT (setq ent2 (car (entsel "\nPick a LINE 1st edge of the trapezoid " ) ) ) ) (NOT (wcmatch (DXF 0 ent2) "LINE")) ) (prompt "\nPick a LINE isn't right, Please pick again") ) (while (OR (NOT (setq ent3 (car (entsel "\nPick a LINE 2nd edge of the trapezoid " ) ) ) ) (NOT (wcmatch (DXF 0 ent3) "LINE")) ) (prompt "\nPick a LINE isn't right, Please pick again") ) (setq po1 (vlax-curve-getStartpoint ent1) ;_bottom edge po2 (vlax-curve-getEndpoint ent1) ) (setq pS2 (vlax-curve-getStartpoint ent2) ;_ 1st side pE2 (vlax-curve-getEndpoint ent2) ) (setq pS3 (vlax-curve-getStartpoint ent3) ;_ 2nd side pE3 (vlax-curve-getEndpoint ent3) ) (cond ((Equal po1 ps3 1e-2) (setq po4 pE3) (cond ((Equal po2 ps2 1e-2) (setq po3 pE2)) ((Equal po2 pE2 1e-2) (setq po3 pS2)) ) ) ((Equal po1 pE3 1e-2) (setq po4 pS3) (cond ((Equal po2 ps2 1e-2) (setq po3 pE2)) ((Equal po2 pE2 1e-2) (setq po3 pS2)) ) ) ((Equal po1 ps2 1e-2) (setq po4 pE2) (cond ((Equal po2 ps3 1e-2) (setq po3 pE3)) ((Equal po2 pE3 1e-2) (setq po3 pS3)) ) ) ((Equal po1 pE2 1e-2) (setq po4 pS2) (cond ((Equal po2 ps3 1e-2) (setq po3 pE3)) ((Equal po2 pE3 1e-2) (setq po3 pS3)) ) ) ) ) ((eq (DXF 0 ent1) "LWPOLYLINE") (setq po_pick (cadr ent1_lst)) (setq po_closest (vlax-curve-getClosestPointTo ent1 po_pick)) (setq para1 (fix (vlax-curve-getParamatpoint ent1 po_closest))) (setq paraE (vlax-curve-getEndParam ent1)) (setq paraS (vlax-curve-getStartParam ent1)) (setq po1 (vlax-curve-getPointAtParam ent1 para1)) (cond ((= para1 0) (setq po4 (vlax-curve-getPointAtParam ent1 paraE) po2 (vlax-curve-getPointAtParam ent1 (+ para1 1)) po3 (vlax-curve-getPointAtParam ent1 (+ para1 2)) ) (if (equal po1 po4 1e-3) (setq po4 (vlax-curve-getPointAtParam ent1 (- paraE 1))) ) ) ((< (1+ para1) paraE) (setq po4 (vlax-curve-getPointAtParam ent1 (- para1 1)) po2 (vlax-curve-getPointAtParam ent1 (+ para1 1)) po3 (vlax-curve-getPointAtParam ent1 (+ para1 2)) ) ) ((= (1+ para1) paraE) (setq po4 (vlax-curve-getPointAtParam ent1 (- para1 1)) po2 (vlax-curve-getPointAtParam ent1 (+ para1 1)) po3 (vlax-curve-getPointAtParam ent1 paraS) ) (if (equal po2 po3 1e-3) (setq po3 (vlax-curve-getPointAtParam ent1 (+ paraS 1))) ) ) ) ) ) (calcThiep po1 po2 po3 po4) (setvar "cecolor" "1") (makeLWPoly (list po1 po2 po_in2 po_in1 po1)) (setvar "cecolor" "256") (if (> (abs dt) Alim) (cond ((> (+ anpha_org beta_org) (+ pi 1e-6)) (setq Alim (limS po1 po2 po3 po4)) (alert (acet-str-format "area to expand is too large (max = %1), so this case results in an area error" (rtos Alim 2 3) ) ) ) ((< (+ anpha_org beta_org 1e-6) pi) (setq Alim (limS po1 po2 po3 po4)) (alert (acet-str-format "area to trim is too large (max = %1), so this case results in an area error" (rtos Alim 2 3) ) ) ) ) ) (setcfg "AppData/trapezoid/area" (rtos dt 2 3)) (SYSVAR-RESTORE) (command "undo" "en") (princ "ok") (princ) ) (defun LM:GetInsideAngle ( p1 p2 p3 ) ( (lambda ( a ) (min a (- (+ pi pi) a))) (rem (+ pi pi (- (angle p2 p1) (angle p2 p3))) (+ pi pi)) ) )

It's not a bug, it's user error for selecting an entity on a layer with the suffix "-DEMO" A belt and braces lisp. You can't select a layer with "-DEMO" in the layer name If the layer already has an associated "-demo" layer it moves it to that layer Otherwise it creates the demo layer and moves it. (defun change_layer_color_ltp ( ent / dlname) (setq dlname (cdr (assoc 8 (entget ent)))) (cond ( (and (not (wcmatch (strcase dlname) "*-DEMO")) (setq dlname (strcat dlname "-DEMO")) (not (tblsearch "layer" dlname)) ) (command "_.layer" "_make" dlname "_color" 40 "" "_ltype" "HIDDEN2" "" "" "_.chprop" ent "" "_layer" DLname "" ) ) ( (tblsearch "layer" dlname) (command "_.chprop" ent "" "_layer" dlname "")) ) (princ) ) (defun c:clcl ( / ss i) ;; selection (princ "\nMake selection: ") (setq ss (ssget '((-4 . "<NOT") (8 . "*DEMO") (-4 . "NOT>")))) ;; now perform the function for every selected entity (setq i 0) (repeat (sslength ss) (change_layer_color_ltp (ssname ss i)) (setq i (+ i 1)) ) (princ) )

Oh well, forget Lee's CAV... (defun c:dtype ( / *error* acadobj activeundo adoc atts col countlst dets hgt i lst msp rown rtn ss tags vals vtab vtable x) (defun *error* ( msg ) (vla-EndUndoMark adoc) (if (not (wcmatch (strcase msg T) "*break*,*cancel*,*exit*")) (princ (strcat "Error: " msg)) ) ) (defun countlst (lst / rtn) ; <--- Lee Mac has one LM:CountItems , but it doesn't hurt to make another. Both returns the same (mapcar '(lambda (x) (if (null (assoc x rtn)) (setq rtn (cons (cons x (- (length lst) (length (vl-remove x lst)))) rtn)))) lst) (reverse rtn) ) (setq acadobj (vlax-get-acad-object) adoc (vla-get-ActiveDocument acadobj) msp (vla-get-ModelSpace adoc) activeundo nil) (if (= 0 (logand 8 (getvar "UNDOCTL"))) (vla-StartUndoMark adoc) (setq activeundo T)) (setq tags '("DRNO") ; <-- List of tags to show hgt 400 ; <-- Table row height col 2000 ; <-- Table column width (I can't be bothered to calculate based on text style) ) (if (setq ss (ssget '((0 . "INSERT")))) (progn (repeat (setq i (sslength ss)) (if (setq atts (vlax-invoke (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'getattributes)) (foreach x atts (if (vl-position (vla-get-TagString x) tags) (setq vals (cons (vla-get-TextString x) vals)) ) ) ) ) (setq vtab (vla-AddTable msp (vlax-3d-point (progn (initget 1) (getpoint "\nSpecify insertion point: "))) (+ 2 (length (setq dets (countlst vals)))) 2 hgt col) rown 1 ) (foreach x '( (0 0 "Attributes") (1 0 "Value") (1 1 "Total") ) (apply 'vla-SetText (append (list vtab) x)) ) (repeat (length dets) (vla-SetText vtab (setq rown (1+ rown)) 0 (caar dets)) (vla-SetText vtab rown 1 (cdar dets)) (setq dets (cdr dets)) ) ) ) (if activeundo nil (vla-EndUndoMark adoc)) (princ) )

Your using the near end so why not add the angle to the block pt so line is at any angle no need to check. I would make the pick line the rail edge rather than centreline. had a go as per PM will add this one as well. I rewrote the block to be a 1x1 sq so it scales the size of the picket. Ver2 would use multigetvals.lsp. (vl-load-com) (defun c:rlayout ( / vars impmet picketthk maxoc num numcores post_oc) (defun *error* ( m ) (and vars (mapcar 'setvar '(osmode pickbox aunits angdir ) vars)) (princ m) (princ) ) ;;; impet1 change this for Imperial or Metric - 1=Imperial, 2.54=cm 25.4=mm, etc... (setq vars (mapcar 'getvar '(osmode pickbox aunits angdir)) impmet 1 picketthk (* impmet 1.) ) (leftside) (setq num 0 maxoc 151. numcores (+ 2 (fix (/ (distance pt1 pt2) maxoc))) post_oc (/ (distance pt1 pt2) (1+ (fix (/ (distance pt1 pt2) maxoc)))) len 75.0 wid 12.0 ) (setvar 'aunits 3) (setvar 'osmode 0) (setvar 'angdir 0) (repeat numcores (command-s "._INSERT" "1sq" (polar pt1 ang (* post_oc num)) len wid ang) (setq num (1+ num)) ) (mapcar 'setvar '(osmode pickbox aunits angdir) vars) (princ) ) (defun leftside ( / tp1 tpp1 pt3) (setq tp1 (entsel "\nSelect a line : ")) (setq tpp1 (entget (car tp1))) (setq pt1 (cdr (assoc 10 tpp1))) (setq pt2 (cdr (assoc 11 tpp1))) (setq pt3 (cadr tp1)) (setq d1 (distance pt1 pt3)) (setq d2 (distance pt2 pt3)) (if (> d1 d2) (progn (setq temp pt1) (setq pt1 pt2) (setq pt2 temp) ) ) (setq ang (angle pt1 pt2)) ) You have an error in working out the 1st point so some hints as the code I am using is confidential I have not fully rewritten. c-c (+ gap wid) (setq dist (distance pt1 pt2)) (setq num (- (fix (/ dist c-c)) 1)) (setq endd (/ (- dist (* num c-c)) 2.0)) Balcony2.mp4

be careful (setq a '(1 2) b a c a) (eq a '(1 2) ) ;nil (eq a b) ;T (equal '(1 2) a ) ;T (= '(1 2) a b) ;nil (= a b c) ;T